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Abstract 


This  study  showed  that  a  set  o-f  procedures  could  be 
written  and  combined  into  a  multivariate  data  analysis 
package  that  will  run  on  a  microcomputer.  This  package  can  be 
used  as  a  teaching  aid  in  the  classroom  or  microcomputer 
center  and  as  a  research  tool  -for  users  to  do  a  'ball-park* 
analysis  o-f  a  data  base.  Included  in  the  package  are 
procedures  to  handle  data  base  definition  and  modification. 
Factor  analysis,  and  Canonical  Correlation  analysis. 

The  PASCAL  Statistical  Procedures  Package  (PSPP)  was 
written  on  an  Apple  lie  microcomputer  using  the  Apple  PASCAL 
language  and  operating  system.  It  will  output  to  a  printer  in 
a  132  character  per  line  format.  If  an  on-line  printer  is 
only  capable  of  80  characters  per  line,  wrap-around  will 
occur. 

The  package  is  composed  of  4  top-level  procedures  stored 
in  Regular  Units  and  163  library  procedures  stored  in  13 
Intrinsic  Units.  Units  are  Apple  PASCAL  structures  that  allow 
for  program  segmentation. 


I .  Introduction 


Statistical  analysis  o-f  data,  in  order  to  suggest 
possible  cause  and  e-f-fect  processes,  has  long  been  an 
accepted  methodology.  Only  recently  have  multivariate 
techniques  become  accepted  as  a  means  o-f  reducing  error 
introduced  by  the  interdependence  between  the  presumed 
independent  variables.  One  o-f  the  most  common  so-ftware 
packages  -for  working  with  multivariate  data  is  SPSS 
(Statistical  Package  -for  the  Social  Sciences)  by  Nie  (17) 
that  has  been  available  -for  some  time  -for  use  on  main-frame 
computers.  However,  there  is  a  lack  o-f  software  for 
microcomputers  which  are  portable  enough  to  be  used  in  the 
classroom. 


SPSS  is  written  for  mainframe  computers  and  can  utilize 
large  amounts  of  core  memory.  It  is  designed  to  produce  a 
great  number  of  combinations  of  statistics  for  large  data 
bases.  It  is  not  user  friendly  and  has  slow  turn  around. 
Consequently,  it  is  not  a  good  tool  to  teach  multivariate 
techniques  to  the  new  student. 


This  thesis  is  an  attempt  to  write  a  package  of 
multivariate  routines,  to  be  used  in  an  interactive  user 
friendly  program,  that  can  be  run  on  a  microcomputer  in  the 


classroom  or  microcomputer  center.  The  question  to  be 


•nr»' 


J, 


answered  is  whether  a  use-ful  set  o-f  routines  can  be  written 


that  can  run  quickly  and  accurately  on  a  microcomputer. 
Obiectives  o-f  the  Research 

1)  Write  routines  to  do  data  input  and  modi -Fi cation. 
Canonical  Correlation  analysis,  and  Factor  analysis,  in 
PASCAL  -For  the  microcomputer. 

2)  Write  a  User’s  Guide  -For  the  package. 

3)  Validate  the  procedures  by  comparing  the  results  to 
those  achieved  via  SPSS. 

Soeci-Fic  Obiectives 

1)  The  routines  should  be  user  -Friendly  to  help  the 
unsophisticated  user. 

2)  Swapping  in  and  out  o-F  core  to  disk  is  required  to 
minimize  core  usage  by  the  routines  in  order  to  maximize  the 
amount  o-F  data  that  can  be  analyzed. 

3)  Sophisticated  matrix  manipulation  techniques  need  to 
be  used  -For  speed  and  to  minimize  core  usage. 

4)  Numerical  analysis  techniques  need  to  be  used  to 
approximate  higher  order  polynomials  to  at  least  the  tenth 
order  -For  necessary  -Flexibility. 

Scope 

The  thesis  consists  o-F  -Four  major  sections:  the  main  body 
and  three  appendices.  The  main  body  introduces  the  problem 
and  discuss  the  procedures  used  -For  and  the  results  o-F  the 
program  validations.  The  -First  appendix  contains  the  User’s 
Guide,  the  second  is  the  results  o-F  the  validation  runs,  and 
the  third  is  the  coding  -For  the  package. 


Th«  User’s  Guide  consists  o-f  an  introduction  and  six 
sections.  The  introduction  outlines  the  package  as  to  the 
techniques  available  and  the  kind  of  data  that  can  be 
analyzed.  The  first  three  sections  specifically  outline  usage 
of  each  of  the  three  main  modules:  DATA,  CANCOR,  and  FACTOR. 
The  fourth  covers  formatting  of  blank  disks  for  storage  of 
data  files.  The  next  outlines  special  features  to  manipulate 
data  files,  and  the  last  describes  the  specific  construction 
of  the  package. 

This  package  is  limited  as  far  as  the  size  of  data  b  '>s 
it  will  handle  (200  records  of  10  variables  each).  Accu>  3' 
is  limited  to  single  precision  (6  or  7  significant  digits) 
and  while  the  routines  are  precompiled,  the  program  is  slow 
in  execution  compared  to  a  mainframe  computer.  These 
limitations  are  driven  by  the  nature  of  microcomputers  and 
their  operating  languages.  However,  because  the  package  is 
interactive,  results  are  available  to  the  user  immediately  in 
a  user  friendly  manner. 
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II.  Background  Stud 


Introduction  and  Organization 

In  order  to  meet  the  objectives  and  £  Dobjectives,  it  was 
necessary  to  research  -five  topic  areas.  First,  to  present  the 
proper  use  o-f  each  o-f  the  techniques,  ar  well  as  insuring 
correct  procedures,  multivariate  data  analysis  in  general  was 
researched.  Next,  because  all  o-f  the  techniques  are  based  on 
matrix  algebra,  matrix  manipulation  techniques  were 
researched  -for  use  in  the  various  procedures.  Third,  in  order 
to  use  matrix  algebra,  it  is  necessary  to  solve  an  eigenvalue 
problem.  Because  the  computer  can  not  solve  it  analytically, 
polynomial  approximations  must  be  used.  To  be  as  -flexable  as 
possible,  it  should  be  capable  o-f  at  least  tenth  order 
polynomial  approximations.  Numerical  analysis  techniques  were 
researched  -for  the  necessary  background  to  solve  such  a 
problem.  Next,  due  to  the  small  core  memory  limitation 
inherent  in  microcomputers,  it  was  necessary  to  research  both 
program  and  data  segmentation  procedures.  Finally,  because 
the  primary  use  oF  this  package  will  be  For  classroom 
instruction,  it  is  necessary  that  the  routines  be  user 
Friendly  and  operational  in  an  interactive  mode.  Computer 
menus  are  a  key  Factor  in  program  useability  as  is 


* idiot-prooFing'  routines  so  that  the  user  is  prevented  From 
making  critical  errors. 


Multivariate  Analysis 


The  bulk  o-f  the  material  used  as  the  basis  -for  procedure 
construction  comes  -from  in-formation  pr  ited  in  the  AFIT 
course  ’Applied  Multivariate  Data  Analy  s. ’  McNichols  (13) 
presents  the  mathematical  background  id  a  step-by-step 
development  -for  each  o-f  the  techniqu  Class  notes  (4) 
supply  supplemental  and  clari-fying  inf c ''^^ation.  The  SPSS 
manual  (17)  contains  a  limited  background  for  the  techniques, 
in  addition  to  procedures  for  running  them  on  the  CDC  6600 
mainframe  computer  for  validation. 

Matrix  Manipulation 

McNichols  (13)  presents  some  of  the  classical  matrix 
algebra,  but  little  on  actual  implementation.  Specific 
procedures  for  multiplication  and  inversion  were  found  in 
Carnahan  (3),  Conte  (5),  and  McMillan  (12).  The  numerical 
analysis  texts  (3,5)  also  contain  necessary  checks  to  insure 
invertabi 1 i ty. 

Numerical  Analysis 

McNichols  (13)  has  a  good  presentation  of  the  eigenvalue 
problem,  but  does  not  get  into  polynomial  approximating 
techniques.  Carnahan  (3),  Conte  (5),  and  Douglass  (7)  provide 
the  necessary  background  and  procedures  to  solve  a  tenth 
order  approximation. 

Memory  Maintenance 

Because  the  compiled  program  code  and  data  storage 
locations  together  would  use  more  memory  space  than  is  in  a 
microcomputer,  it  is  necessary  to  split  either  the  data  or 


the  program  into  segments.  Data  structures  needed  to  be 
developed  to  minimise  the  use  o-f  core  by  overwriting  the  same 
memory  location  whenever  possit'p.  It  was  Iso  necessary  to 
not  duplicate  variable  structures  by  usin  'call  by  location’ 
procedures  as  opposed  to  'call  by  value'  outines.  Lewis  (10) 
contains  several  procedures  -for  developing  such  structures. 
The  swapping  o-f  data  between  core  and  disk  requires 
specialized  inter-face  routines  which  can  be  found  in  Swanson 
(19)  . 

The  PASCAL  programming  language  allows  the  usage  o-f 
routines  that  can  split  a  program  into  'units'  that  are 
stored  in  'libraries'  and  are  present  in  memory  only  when 
needed.  Merritt  (14,15,16)  provides  an  excellent  explanation 
and  guide  -for  usage  of  those  routines.  General  information 
about  PASCAL  is  found  in  the  Apple  PASCAL  manuals  (1,2)  and 
Zaks'  Introduction  to  PASCAL  (20) . 

Interactive  Driver  and  Graphics 

As  mentioned  above,  ease  in  program  useability  is 
centered  around  effective  computer  menus.  Root  (18)  presents 
to  the  public  domain  a  powerful  procedure  for  developing 
customized  menus.  Gome  aspects  of  his  procedure  were  useful 
for  data  input  as  well  as  aiding  in  user  selection  of  program 
options. 

In  order  for  programs  to  continue  executing  despite  any 
errors  made  by  the  user,  it  is  necessary  to  'idiot  proof'  the 
software.  Cox  (6)  presents  several  techniques  that  protect 


both  the  program  and  the  disk 


Finally,  user  -friendly  programs  need  to  present  solutions 
in  a  -format  that  is  easily  understood  and  interpreted  by  the 
user.  Graphics  displays  do  this  much  better  than  lists  o-f 
numbers.  Procedures  -for  numerous  graphics  generations  are 
■found  in  Korites  (9). 


A  review  o-f  statistical  and  microcomputer  journals  -failed 
to  turn  up  programs  o-f  a  multivariate  nature  that  could  do 


Canonical  Correlation  or  Factor  analysis  on  a  microcomputer. 
The  materials  indicated  above  were  su-f-ficient  to  solve  the 
research  problem  in  question:  the  development  o-f  a 
multivariate  analysis  package  -for  use  in  the  classroom  on  a 
microcomputer.  With  this  program  an  instructor  can  teach  the 
techniques  necessary  -for  the  student  to  run  multivariate  data 
analysis  programs,  such  as  SPSS,  on  main— frame  computers  with 
larger  data  bases.  This  will  not  only  increase  student 
understanding  o-f  multivariate  analysis  but  will  also  decrease 
the  time  spent  learning  the  techniques  on  non  user  -friendly 
systems. 
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III.  Packags  Validation 


In  order  to  check  the  validity  o-f  the  numbers  produced  by 
the  package,  a  cursory  comparison  was  made  between  the  output 
o-f  the  package  and  the  output  o-f  SPSS  while  using  the  same 
data  bases.  Included  in  Appendixes  A  &  B  are  the  data  and 
outputs  -from  both  the  package  and  SPSS. 

Validation  Runs 

The  -first  section  o-f  Appendix  B  is  the  SPSS  output  for 
the  data  used  as  calculation  examples  throughout  the  User’s 
Guide  (Appendix  A).  Both  the  results  of  CANCOR  and  FACTOR  are 
represented . 

The  next  section  includes  data  bases  from  an  original 
Computer  Performance  Analysis  data  base  that  was  164  records 
long  by  10  variables  wide.  The  data  base  was  first  edited  by 
deleting  one  record  that  was  not  representative  of  the  rest. 
Next,  four  original  variables  plus  two  computed  variables 
(numeric  sums  of  two  original  variables)  were  used  to  make  a 
CANCOR  data  base.  Finally,  six  original  variables  were  used 
to  make  a  FACTOR  data  base. 

Both  of  the  large  data  bases  were  then  run  through  both 
the  package  and  SPSS  and  the  results  placed  in  the  Appendix 
B.  It  should  be  noted  that  SPSS,  which  keeps  track  of  more 
significant  digits,  prints  out  more  decimal  places  than  PSPP. 
For  comparison,  round  the  SPSS  outputted  values  to  the  same 
number  of  decimal  places  printed  by  PSPP. 


to  the  two  packages  with  three  eKceptions.  As  before,  the  CHI 
Square  test  statistics  di-f-fer  slightly  (first  or  second 
decimal  place)  with  the  PSPP  results  being  more  conservative 
(smaller)  than  those  produced  by  SPSS.  Next,  the  Coefficients 
for  Canonical  Variables  output  of  both  sets  show  a  sign 


reversal 

for  CANVAR  1. 

As  before. 

this  would 

be 

the 

consequence 

of  a  sign 

reversal  of 

all  values 

in 

the 

eigenvector 

assoc i at ed  with 

the  first  eigenvalue.  Lastly, 

two 

of  the  Coefficients  for  Canonical  Variables  in  CANVAR  3  of 
the  Second  Set  differ  slightly  in  the  fourth  decimal  place. 
This  is  probably  due  to  the  differences  in  accuracy  due  to 
significant  digit  storage. 

FACTOR  Validation  Data 

A  comparison  of  the  SPSS  output  with  the  calculations 
produced  by  PSPP  showed  identical  values  through  the 
eigenvalue  outputs  where  there  is  a  difference  in  the  fourth 
decimal  place  for  two  of  the  six  eigenvalues.  Further 
calculations  based  upon  these  eigenvalues  show  an  increasing 
divergence  between  the  SPSS  and  PSPP  outputs.  The  Factor 
Matrix  output  has  a  worst  case  divergence  in  the  fourth 
decimal  place,  while  both  the  Commonality  and  Factor  Score 
Coefficients  outputs  have  worst  case  divergences  in  the  third 
decimal  place.  No  comparison  was  done  of  the  Factor  Scores, 
but  they  would  probably  be  comparable  through  at  least  the 
second  decimal  place. 

There  is  also  a  sign  a  reversal  in  the  second  and  third 


Factors  in  both  the  Factor  Matrix  and  the  Factor  Score 


this  would  be  the 


Coe-ff  icients  outputs.  As  be-fore. 


consequence  of  a  sign 

reversal 

of 

all  the 

values 

in  the 

ei gen vector s  assoc i ated 

with 

the 

second 

and 

third 

eigenvalues. 

Conclusion 

The  results  o-f  the  calculations  done  by  PSPP  are  very 
close  to  those  done  by  SPSS.  The  discrepancies  are  probably 
the  result  o-f  di-f-ferent  calculation  routines  coupled  with  the 
di-f-ferences  in  accuracy  due  to  signi-ficant  digit  storage. 
Because  the  data  in  the  bigger  data  bases  start  with  a  large 
number  o-f  decimal  places,  subsequent  calculations  are 
constantly  being  truncated  when  more  than  6  or  7  signi-ficant 
digits  are  produced. 

It  should  be  noted  that  the  PSPP  runs  were  made  using  the 
most  accurate  setting  o-f  Epsilon  when  the  eigenvalues  were 
calculated.  This  setting  requires  more  iterations,  and 
consequently  more  time;  especially  -for  larger  matrices.  I-f  a 
larger  size  -for  Epsilon  is  used,  the  eigenvalues  and  all 
subsequent  calculations  based  on  those  eigenvalues  di-f-fer 
-from  those  produced  by  SPSS.  It  is  up  to  the  user  to  decide 


which  is  more 

important:  the 

speed  in 

calculating 

the 

ei gen va 1 ues  or 

their  accuracy. 

The  default 

Epsi 1 on  of  . 

0001 

was  chosen  as 

a  good  trade 

off  value 

between  speed 

and 

accuracy.  The  eigenvalues  calculated  using  the  default  appear 
to  be  accurate  through  at  least  two  decimal  places. 
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IV.  Rccommendat ions 

Tho  -future  will  most  likely  see  an  ever  increasing  use  o-f 
computers  in  educational  settings  as  an  aid  to  learning  in 
all  disciplines.  Consequently,  the  need  -for  so-ftware  to  run 
on  portable  microcomputers  will  also  increase.  This  study  has 
shown  that  it  is  possible  to  write  a  package  o-f  routines  that 
can  be  used  by  an  instructor  in  the  classroom  or 
microcomputer  center  in  teaching  multivariate  data  analysis. 

Further  research  is  recommended  in  this  area  using  the 
procedures  in  this  thesis  as  a  starting  point.  It  should  be 
possible  to  write  more  multivariate  routines  that  use  the 
data  section  and  applicable  parts  o-f  the  other  sections. 
Routines  to  do  Multiple  Analysis  of  Variance  (MANOVA) , 
Multiple  Regression,  Residual  Analysis,  and  Discriminant 
Analysis  are  a  few  areas  that  could  be  added. 

Improvements  could  also  be  made  within  the  body  of  the 
current  code.  First,  the  use  of  PASCAL  Long  Integer  variables 
instead  of  Real  variables  could  greatly  increase  the  accuracy 
and  flexability  of  the  package  at  the  expense  of  speed, 


memory,  and  disk  space.  Real  number  storage,  while  simpler 
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Introduction 


Multivariate  Statistics 

Statistical  analysis  o-F  data, 
possible  cause  and  e-f-fect  processes,  has  long  been  an 
accepted  methodology.  Only  recently  have  multivariate 

techniques  become  accepted  as  a  means  o-F  reducing  error 
introduced  by  the  interdependence  between  the  presumed 
independent  variables.  The  PASCAL  Statistical  Procedures 
Peckage  (PSPP)  is  a  collection  oF  routines  that  can  handle 
data  input,  storage,  and  manipulation  plus  the  two 

multivariate  techniques  oF  Canonical  Correlation  analysis  and 
Factor  (Principal  Component)  analysis.  Some  user  knowledge  is 
enpected  about  the  operation  and  booting  oF  microcomputers. 
Data  Structure 

The  PSPP  is  designed  to  work  only  with  real  data  values. 
All  integer  inputs  are  stored  as  reals.  Alphabetic  entries 
must  be  transposed  to  numerals;  A/B/C  could  be  entered  as 
1/2/3  or  -1/0/1,  as  desired.  Further,  variables  should  be 
pre-seal ed  so  that  they  are  not  very  large  or  very  small. 
There  is  a  limit  oF  7  signiFicant  digits  in  internal  storage. 
Larger  numbers  will  be  rounded  and  represented  in  scientiFic 
notation.  Entries  should  be  rescaled  to  representations  oF 
millions  oF  units  or  hundredths  oF  a  unit,  as  applicable.  It 
is  important  to  note  that  arithmetic  operations,  such  as  the 
calculation  oF  means,  done  on  data  transposed  From  the 


nominal  <e.g.  male  /  -female)  type  or  the  ordinal  <e.g. 
high-school  /  under-graduate  /  graduate)  type  could  produce 
meaningless  numbers.  Finally,  there  are  no  provisions  to 
handle  missing  data.  A  number  must  always  be  entered;  even  i-F 
only  a  zero.  I-f  this  would  bias  results,  consideration  should 
be  given  to  excluding  cases  with  missing  data  -fields. 
Limitations 

The  PSPP  is  limited  in  the  size  o-f  data  bases  it  can 
handle.  There  is  an  upper  limit  o-f  200  records  or  cases  o-f 
data,  each  with  a  limit  o-f  10  variables  or  data  -fields. 
Analysis  o-f  larger  data  bases  should  be  done  via  SPSS  on  a 
main-frame  computer.  There  is  a  limit  o-f  80  columns  or 
characters  per  record  so  that  one  entire  record  can  be  viewed 
on  one  line  o-f  the  microcomputer  screen.  There  is  a  minimum 
o-f  8  columns  and  a  maximum  o-f  15  columns  -for  each  -field  width 
(variable).  This  includes  room  for  6  significant  digits,  a 
leading  minus  sign,  a  decimal  point,  scientific  notation  if 
required,  and  leading  spaces.  Data  should  be  pre-seal ed  as 
described  above  to  meet  this  requirement.  Finally,  there  is 
an  upper  limit  of  15  characters  in  the  storage  of  field 
names.  Longer  names  are  automatically  truncated  on  entry. 
Further,  the  names  are  truncated  down  to  their  designated 
field  width  when  displayed  on  the  screen.  This  means  that  the 
name  ’EDUCATION’  will  be  displayed  as  ’EDUCATIO’  if  the  field 
width  is  8.  It  should  be  noted  that  if  a  printer  is  being 
used,  data  lines  are  expanded  up  to  132  columns  with  spaces 
inserted  between  the  fields  and  longer  names  printed.  If  the 
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printer  is  limited  to  80  columns,  wrap-around  will  occur  i-f 
more  than  80  characters  are  printed  on  a  line. 

System  Start-uo 

The  PSPP  is  written  to  be  run  on  an  Apple  lie  system  with 
two  disk  drives  and  printer  connected.  It  will  run  without  a 
printer.  The  program  disk  should  be  inserted  in  the  boot 
drive.  Side  1  up.  A  pre-Formatted  data  disk  should  be  inserted 
in  the  non-boot  drive.  A-fter  booting,  the  sequence  in  Figure 
1  should  be  -followed  to  run  PSPP. 


>C0MMAND:  E(DIT,  r<un, 

s 

FdLE, 

C(0MP, 

L(INK, 

X (ECUTE, . . 

>SWAPPING  IS  OFF 
>T0GGLE  SWAPPING 

Y 

>command:  e<dit,  r<un, 

X 

F(ILE, 

C<0MP, 

L(INK, 

X (ECUTE, . . 

>EXECUTE  WHAT  FILE? 
PSPP  (return) 

Figure  1.  System  Start-up 


Use  o-f  SWAPPING  allows  -for  more  memory  use.  It  is  required  i-f 
the  MODIFILE  procedure  in  the  DATA  module  is  going  to  be 
used. 

In  Figure  1,  and  throughout  the  rest  o-f  the  User’s  Guide, 
computer  prompts  and  messages  are  proceeded  with  a  ’ 
character.  All  others  are  as  the  user  would  enter  at  the 
keyboard;  with  notes  in  parenthesis. 

Introductory  remarks,  i-f  selected  a-fter  booting,  explain 
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how  to  make  entries.  There  are  two  types  o-f  user  inputs: 


1  -  When  asked  to  *  ENTER*  a  value,  the  user  should 

type  a  response,  the  press  the  (return)  key; 

2  -  When  asked  to  ’SELECT*  an  option  (-from  a  menu  or 

list  o-f  options)  or  asked  a  YES  or  NO  question, 
the  (return)  key  need  not  be  pressed. 

Whenever  a  routine  finishes,  control  is  returned  to  a  higher 
level  menu  and  the  user  must  then  select  how  to  proceed. 

In  order  to  format  blank  data  disks,  reference  Section 
IV.  Other  special  procedures  for  manipulating  the  data  disks 
are  explained  in  Section  V.  Included  are  procedures  that  L 
(list  directory),  R  (remove  a  file),  C  (change  a  file  name), 
and  K  (crunch  available  space). 


The  Data  Manipulation  Module  (DATA)  is  the  largest  and 
most  complicated  part  o-f  the  P5PP.  It  handles  the  input  o-f 


new  data  into  a  data  -File,  saving  that  data  -File  to  disk, 
loading  that  data  -File  -From  disk,  the  modification  o-F  data  in 
a  data  -File,  and  the  printing  or  echoing  o-F  the  data  -File  to 
either  the  printer  and  the  screen,  or  just  the  screen.  Be-Fore 
proceeding,  the  user  should  re-Ference  Section  IV  on  the 
Formatting  o-F  Blank  Data  Disks  so  that  any  new  data  -Files 
made  can  be  saved. 

Make  File  Routine 

Once  selected,  MAKEFILE  gives  the  user  the  option  o-F 
viewing  the  -Following  instructions  or  proceeding  immediately 
to  the  GATHERDATA  routine.  Be-Fore  entering  data,  the  user 
must  modi-Fy  the  data  with  certain  considerations  in  mind. 
First,  all  entries  must  be  numeric  because  data  is  stored  in 
a  real  array.  Nominal  categories  such  as  Male/Female  that 
have  been  coded  as  M/F,  or  even  A/B,  need  to  be  recoded  as 
numbers,  such  as  1/2.  Missing  or  blank  -Fields  in  a  record 
might  be  stored  as  zero,  but  consideration  should  be  given  to 
excluding  that  record  i-F  that  would  bias  desired  results. 
Next,  there  are  upper  limits  o-F  200  records  per  data  -File  and 
10  -Fields  per  record.  There  is  a  -Further  limit  o-F  80 
characters  per  record.  This  includes  all  decimal  points  and 
spaces  between  -Fields.  This  is  done  to  allow  the  viewing  o-F 


one  complete  record  on  an  80  column  screen.  Lastly,  the  -first 
■field  o-f  any  record  cannot  be  9999,  as  this  is  the  value  used 
to  signi-fy  data  entry  completion. 

The  data  is  entered  into  the  -file  in  three  stages.  First, 
the  number  o-f  data  -fields  or  variables  is  requested.  This 
value  can  be  any  number  between  1  and  10  inclusive,  but  only 
the  integer  part  is  saved.  The  user  is  then  shown  the  value 
the  computer  accepted  and  is  given  the  option  o-f  changing  it. 
For  instance,  i-f  the  user  inputs  6.7,  the  computer  will 
accept  6  as  the  number  o-f  -fields. 

The  name  and  width  o-f  each  -field  is  then  requested.  The 
user  must  remember  to  leave  room  for  the  largest  (in  number 
of  characters)  value  in  each  field,  as  well  as  decimal  points 
and  spaces  between  fields.  There  is  a  minimum  limit  of  8  and 
a  maximum  of  15  characters  per  field.  To  calculate  field 
width,  take  the  number  of  characters  desired  left  of  the 
decimal  point  and  add  7.  For  example,  if  23.45  is  the  largest 
value  in  a  field,  set  the  field  width  to  9  (i.e.  2-4-7). 

The  field  name  should  be  less  than  or  equal  to  the  field 
width;  otherwise  the  name  will  automatically  be  truncated  to 
fit.  For  example,  ’EDUCATION’  will  be  stored  as  ’EDUCATIO’  if 
the  field  width  is  8.  Once  all  names  and  widths  have  been 
entered,  the  user  is  given  the  option  of  making  changes  until 
the  desired  structure  is  achieved. 

Finally,  each  record  is  entered,  one  field  at  a  time. 
After  the  last  field  is  entered,  the  user  is  asked  if  any 
changes  need  to  be  made  before  moving  on  to  the  next  record. 


It  •hould  be  noted  that  the  computer  does  not  check  whether 
the  field  width  was  violated  by  any  entry.  This  will  not 
affect  any  computations,  but  when  the  data  is  echoed,  the 
data  will  not  be  printed  in  neat  columns  and  wrap-around  on 
the  screen  may  occur  if  there  are  more  than  80  columns  of 
data.  After  the  last  record  has  been  entered,  and  the  number 
of  records  (NUMREC)  is  less  than  200  (MAXREC) ,  the  value  9999 
should  be  entered  into  the  first  field  to  signify  data  entry 
completion.  After  the  last  record  has  been  entered  and 
approved  by  the  user,  control  is  returned  to  the  main  Data 
Module  menu. 

Figure  2  is  an  example  of  how  these  criteria  can  be  met, 
given  the  case  where  sex  and  letter  grades  of  five  students 
need  to  be  entered. 


Donna 

John 


X  Grade 

StuNum 

Bex 

Grade 

B+ 

1 . 00000 

1 . 00000 

3.30000 

B 

2.00000 

2.00000 

3.00000 

A- 

==> 

3.00000 

1 . 00000 

3.70000 

A 

4.00000 

2.00000 

4.00000 

C 

5.00000 

1 . 00000 

2.00000 

Figure  2.  Sample  Input 


Before  this  routine  is  run,  the  user  should  ensure  that  a 
properly  formatted  data  disk  is  in  the  non-boot  disk  drive, 
and  that  there  is  enough  room  on  that  disk.  There  is  room  on 
one  disk  for  about  14  different  data  files,  if  all  are  the 
maximum  size  of  200  records  by  10  variables  —  more  if  the 


til»s  ar»  smaller.  Files  are  automatically  written  at  the 
beginning  o-f  the  largest  -free  area  on  the  disk.  It  should  be 
noted  that  changing  a  -file  and  then  resaving  it  with  the  same 
name  will  cause  the  relative  positions  o-f  -files  on  a  disk  to 
change.  This  could  lead  to  a  subsequent  save  failure  due  to 
lack  of  space,  if  the  largest  available  area  on  the  disk  is 
smaller  than  the  file  size.  See  Section  V  for  instructions  on 
*Krunching*  data  files  to  consolidate  available  space. 

When  activated  by  the  user,  SAVEFILE  asks  the  user  to 
enter  the  desired  file  name.  The  computer  will  treat  lower 
case  and  upper  case  letters  the  same.  There  is  a  limit  of  10 
characters  in  the  file  name  and  the  first  character  must  be  a 
letter.  The  data  file  is  then  saved  to  a  properly  formatted 
data  disk  under  the  name:  <user  inputed  name>.TEXT.  The  .TEXT 
suffiM  is  used  only  by  the  computer  and  should  NOT  be  used  by 
the  user.  When  the  save  is  successfully  completed,  or  the 
user  declines  to  try  another  save  after  a  failure,  control  is 
returned  to  the  main  Data  Module  menu. 

Load  Data  Routine 

When  activated  by  the  user,  LOADDATA  asks  the  user  to 
enter  the  desired  file  name.  If  the  desired  filename  or  disk 
is  not  found,  the  user  is  notified  of  the  failure  and  offered 
a  chance  to  try  again.  Once  the  specified  file  is  found,  the 
load  begins  and  overwrites  any  data  previously  existing  in 
the  data  arrays.  When  the  load  is  successfully  completed, 
control  is  returned  to  the  main  Data  Module  menu. 


Tha  MODIFILE  routine  is  the  largest  and  most  complex 
section  o-f  the  Data  Module.  Once  a  data  -file  has  been  loaded 
into  memory,  either  by  the  user  with  MAKEFILE  or  -from  disk 
using  LOADDATA,  the  various  parts  of  MODIFILE  can  be  used  to 
add  a  record,  delete  a  record,  add  a  field,  delete  a  field, 
change  a  record,  or  change  a  field.  It  should  be  noted  that 
additions  cannot  be  made  that  would  violate  the  upper  limits 
of  10  fields  per  record  or  200  records  per  file.  NOTE:  The 
SWAPPING  option  should  have  been  set  when  the  system  was 
booted  in  order  for  MODIFILE  to  run  properly. 

Add  a  Record.  When  activated  by  the  user,  ADDAREC  has 
the  user  enter  a  record  one  field  at  a  time  in  the  same 
manner  as  used  in  the  MAKEFILE  routine.  Once  all  fields  have 
been  entered,  the  user  has  the  option  of  making  changes  until 
the  record  is  acceptable.  Once  accepted,  the  record  is  stored 
at  the  end  of  the  data  array. 

Delete  a  Record.  When  activated  by  the  user,  SUBAREC 
asks  the  user  the  index  of  the  record  to  be  deleted.  This 
number  must  be  between  1  and  NUMREC  (number  of  records  in 
file).  The  selected  record  is  then  displayed  for  the  user  who 
has  the  option  of  either  proceeding  with  or  canceling  the 
removal  of  that  record.  If  the  removal  is  accepted,  that 
record  is  overwritten  by  the  last  record  in  the  file  and 
NUMREC  is  decreased  by  one. 

Add  a  Field.  When  activated  by  the  user,  ADDAFLD  has  the 


user  define  the  new  field  width  and  name  in  the  same  manner 


usad  by  the  MAKEFILE  routine.  A  check  le  made  to  insure  that 
the  upper  limit  o-f  80  characters  per  record  is  not  violated. 
Once  properly  defined,  the  new  field  is  filled  by  the 
FILLFIELD  routine  described  below. 

Delete  a  Field.  When  activated  by  the  user,  SUBAFLD 
displays  the  fields  and  widths  of  those  that  are  currently  in 
the  file.  The  user  is  then  asked  the  index  of  the  field  to  be 
deleted,  if  any.  This  number  must  be  between  1  and  WIDTH 
(number  of  fields  in  a  record).  If  one  is  selected,  that 
field  is  overwritten  by  the  last  field  in  the  file  and  WIDTH 
is  decreased  by  one.  A  warning  is  displayed  if  the  last  field 


in  the  file  was  deleted. 


When  activated  by  the  user,  CHGAREC 


asks  the  user  the  index  of  the  record  to  be  changed.  This 
number  must  be  between  1  and  NUMREC  (number  of  records  in 
file).  The  selected  record  is  then  displayed  for  the  user  who 
has  the  option  of  either  proceeding  with  or  canceling  the 
change  of  that  record.  If  a  change  is  designated,  the  user 
has  the  option  of  making  changes  until  the  record  is 


acceptable. 


a  Field.  When  activated  by  the  user,  CHGAFLD 


displays  the  fields  and  widths  of  those  that  are  currently  in 
the  file.  If  a  change  is  still  desired,  the  routine  has  the 
effect  of  deleting  the  selected  field  and  then  adding  a  field 
in  that  position  in  the  same  manner  as  ADDAFLD.  Once  properly 
defined,  the  new  field  is  filled  by  the  FILLFIELD  routine 


described  below. 


A 


Fill  Field.  When  activated  by  either  the  ADDAFLD  or 
CH6AFLD  routines,  FILLFIELD  gives  the  user  three  options  -for 
-filling  the  designated  -field  and  definitions  of  each.  The 
Recode  option  fills  the  specified  field  with  user-selected 
constants;  based  on  partition (s>  within  that  or  a  different 
field.  The  Compute  option  computes  and  stores  in  the 
specified  field  the  results  of  one  or  more  arithmetic 
operations  on  one  or  more  fields.  The  User  Select  option 
accepts  data  as  input  by  the  user  at  the  keyboard,  one  record 
at  a  time. 

Recode.  When  activated  by  the  user,  RECODE  first 
displays  a  set  of  instructions.  The  routine  works  by 
partitioning  the  data  of  a  selected  field  based  on  range (s) 
between  two  endpoints.  The  user  has  the  option  of  entering 
numeric  endpoints  or  using  the  values  LOWEST  and  HIGHEST. 
Those  points  indicate  the  two  extremes  of  the  data  field.  It 
should  be  noted  that  once  started,  the  user  cannot  leave  the 
RECODE  routine  without  using  LOWEST  and  HIGHEST  at  least 
once.  This  is  done  to  ensure  all  data  points  in  the  field  are 
recoded.  The  routine  is  repeated  as  many  times  as  desired  by 
the  user,  but  no  actual  recoding  is  done  until  the  user  exits 
the  routine.  At  that  time,  the  NEWFIELD  buffer,  where  all 
recodes  are  temporarily  stored,  is  written  over  the  specified 
field.  Figure  3  shows  how  a  recode  session  might  look.  When 
exiting  RECODE  FIELD,  after  having  set  LOWEST  and  HIGHEST  at 
least  once,  the  user  has  one  last  option  of  making  the  save 
final  or  exiting  without  saving. 


>Enter  -field  to  use  in  recoding: 

4  (return) 

>Select  desired  option: 

>1  -  Enter  a  partition 
>2  -  Exit  RECODE  FIELD 

1 

>Set  partition  bottom  edge  using: 

>1  -  Numeric  endpoint 
>2  -  LOWEST  value 

2 

>Set  partition  top  edge  using: 

>1  -  Numeric  endpoint 
>2  -  HIGHEST  value 

1 

>Enter  upper  endpoint: 

12.0  (return) 

I 

j 

>Enter  value  to  recode  partition  with: 

1  (return) 

>Partition  is: 

>Recode  LOWEST  to  12.00000  with  1.00000 

>Select  desired  option: 

>1  -  Proceed  with  RECODE 
>2  -  Skip  this  RECODE 

1 

>Recoding.  .  . 

>Select  desired  option: 

>1  -  Enter  a  partition 
>2  -  Exit  RECODE  FIELD 

2 

>WARNIN6:  Must  reference  both  HIGHEST  and  LOWEST 

>Press  any  key  to  continue  (return) 

>Select  desired  option: 

>1  -  Enter  a  partition 
>2  -  Exit  RECODE  FIELD 


1 


Compute.  When  activated  by  the  user,  COMPUTE  displays 
some  instructions  prior  to  proceeding.  This  routine  works  by 
per-forming  a  computation  based  on  one  or  two  -fields  and/or 
user  inputted  constants  and  one  operand.  Any  undefined 
results  will  be  stored  as  99.9999.  The  procedure  can  be 
executed  more  than  once  for  two  or  more  operations  with  the 
specified  field  holding  the  intermediate  value (s).  The  user 
is  first  asked  whether  to  use  a  field  or  a  number  for  the 
first  variable.  Depending  on  selection,  the  index  of  the 
field  or  the  value  of  the  number  is  then  entered.  Next,  one 
of  the  operands  from  Figure  4  is  selected  by  the  user. 


These 

require  a  second  variable: 

A  -  Addition 

(  +  ) 

B  -  Subtraction 

(-> 

C  -  Multiplication 

(♦) 

D  -  Division 

(/) 

These 

operate  on  the  first 

variable: 

E  -  Square 

(SQR) 

F  -  Square  Root 

(SORT) 

6  -  Natural  Log 

(LN) 

H  -  Log  Base  10 

(LOG) 

I  -  Exponential 

(EXP) 

J  -  Absolute  Value 

(ABS) 

K  -  Truncate 

(TRUNC) 

L  -  Round 

(ROUND) 

Figure  4.  COMPUTE  Operands 


If  the  operand  requires  a  second  variable,  it  is  entered  in 
the  same  manner  as  the  first.  The  computation  selected  by  the 
user  is  then  displayed  for  final  approval  before  any 
computation  is  made.  As  an  example  of  how  this  procedure 


might  be  used,  assume  that  it  is  desirable  to  multiply  the 
contents  o-f  Field  #3  by  2,  add  the  contents  o-f  Field  #7,  and 
store  the  results  in  Field  #4.  During  the  -First  time  in 
COMPUTE,  Field  #3  is  designated  -for  Variable  #1,  the  multiply 
operand  is  selected,  the  value  2.0  is  designated,  and  the 
resultant  is  stored  in  Field  #4.  During  the  second  time  in 
COMPUTE,  Field  #4  is  designated  -for  Variable  #1,  the  addition 
operand  is  selected.  Field  #7  is  designated  -for  Variable  #2, 
and  the  resultant  is  stored  back  in  Field  #4. 

User  Input.  When  activated  by  the  user,  USER INPUT 
displays  a  warning  about  inputting  values  that  exceed  the  MAX 
WIDTH  -For  the  -Field.  I-F  there  is  a  value  too  wide,  the  user 
should  enter  the  rest  o-F  the  values,  run  the  CH6AFLD  routine 
to  expand  the  -Field  width,  and  then  exit  FILLFIELD  without 
changing  the  -Field  values.  I-F  the  user  decides  to  continue 
with  U8ERINPUT,  the  values  are  then  input  one  record  at  a 
time.  The  current  record  index  and  the  total  number  oF 
records  (NUMREC)  are  displayed.  Any  errors  on  entry  should  be 
noted  and  later  corrected  using  the  CH6AREC  routine. 

Once  completed,  all  oF  the  six  parts  oF  MODIFILE  return 
control  to  the  MODIFILE  menu,  where  the  user  has  the  option 
oF  Further  modiFications  or  exiting  the  routine.  AFter 
exiting  MODIFILE,  control  is  returned  to  the  main  Data  Module 
menu. 

Echo  File  Routine 


When  activated  by  the  user,  ECHOFILE  asks  the  user  iF  a 
limited  or  complete  echocheck  is  desired.  IF  a  limited  one  is 


selected,  the  user  is  given  the  option  o-f  which  -fields  to 


print.  A-fter  selection,  the  user  is  then  given  the  option  o-f 


making  changes  until  satis-fied.  Once  the  -fields  have  been 


-finalized,  the  user  is  given  the  option  o-f  sending  the 


echocheck  only  to  the  screen  or  to  the  screen  and  printer  (i-f 


there  is  one  available).  The  file  is  then  echoed,  one  page  at 


a  time,  with  the  user  pressing  any  key  to  display  the  next 


■■.-•v'vl 


II.  Canonical  Correlation 


The  Canonical  Correlation  Module  (CANCOR)  has  the  user 
select  two  sets  o-f  variables  -from  the  data  array.  It  then 
derives  a  linear  combination  -from  each  set  so  that  the 
correlation  between  the  two  linear  combinations  is  maximized. 
In  other  words,  the  goal  is  to  account  -for  a  maximum  amount 
o-f  the  relationship  between  the  two  sets  o-f  variables.  It  is 
similar  to  a  multiple  regression  problem  with  more  than  one 
criterion  variable  as  well  as  more  than  one  predictor 
variable.  The  data  in  Table  I  is  the  data  used  in  the 
examples  throughout  this  section. 


Yl 

Y2 

xi 

X2 

1 

3 

2 

4 

3 

2 

4 

3 

4 

b 

5 

7 

5 

3 

6 

4 

7 

5 

8 

6 

6 

8 

7 

9 

9 

7 

6 

8 

8 

9 

9 

7 

5 

7 

3 

6 

9 

4 

9 

b 

Table  I.  Example  CANCOR  Data 


Assign  Variables.  When  -first  activated  by  the  user, 
CANCOR  calls  ASSIGNVARS  -for  variable  selection.  The  user  is 
then  shown  the  current  status  -for  each  o-f  the  -fields  and 
asked  whether  to  assign  a  predictor,  assign  a  criterion, 
remove  an  assignment,  or  exit  ASSIGNVARS.  Once  entered,  this 


routine  will  not  allow  the  user  to  exit  until  at  least  two 


variables  are  assigned  to  each  set.  This  means  that  there 
should  be  at  least  -four  variables  in  the  data  base  before 
calling  CANCOR.  The  user  has  the  option  of  making  as  many 
changes  as  needed  to  correctly  assign  the  variables  to  the 
two  sets. 

Calculate  Statistics.  The  next  routine  called  by  CANCOR 
calculates  and  prints  the  means  and  standard  deviations  for 
each  of  the  selected  variables,  segregated  by  set.  If  a 
printer  is  on-line,  the  results  are  printed  there  as  well  as 
on  the  screen.  Figure  5  is  the  output  using  the  example  data. 


Variable 

Mean 

Standard  Deviation 

Y1 

6.00000 

2.48633 

Y2 

5.75000 

2.378B8 

XI 

6.33333 

2.42462 

X2 

6.41667 

1 . 97523 

Figure  5.  Statistics  Output  Example 


At  this  point,  the  user  is  given  the  option  of  exiting  CANCOR 
without  proceeding  to  data  standardization. 

Standardize.  In  preparation  for  calculating  the  Sample 
Correlation  Matrix,  the  selected  variables  are  standardized 
by  subtracting  the  field  mean  and  dividing  by  the  field 
standard  deviation.  It  should  be  noted  that  if  there  is  only 
one  record,  the  standard  deviations  are  zero,  the  data  values 
become  undefined,  and  are  represented  as  99.9999.  The 


standardized  values  are  written  over  the  original  values  in 


the  data  array,  but  are  not  automatically  saved  to  disk. 


Generate  Correlation  Matrix.  The  next  routine  cal  lea  by 
CANCOR  generates  and  prints  the  Sample  Correlation  Matrix  of 
the  designated  -Fields  by  -first  generating  smaller  -first  and 
second  set  sel-F-correlation  matrices  and  the  -First/second  set 
cross-correlation  matrix.  These  partitions  are  then  stored  in 
CORRMATRIX  as  shown  in  Figure  6.  It  should  be  noted  that  the 


R(YY) 

R(YX) 

CORRMATRIX  =  : 

R(XY) 

1 

R(xx>  : 

Figure  6.  Sample  Correlation  Matrix 


main  diagonal  is  -forced  to  1.0,  despite  the  -fact  that 
round-o-f-f  errors  would  produce  values  slightly  o-f-f  that 
ideal.  Figure  7  is  the  output  using  the  example  data.  At  this 


Y1 

Y2 

XI 

X2 

Y1 

1 . 0000 

0.5687 

0.8445 

0.6479 

Y2 

0.5687 

1 . 0000 

0.4728 

0.8755 

Xl 

0.8445 

0.4728 

1 . 0000 

0. 5758 

X2 

0.6479 

0.8775 

0. 5758 

1 . 0000 

Figure  7.  CORRMATRIX  Output  Example 


point,  the  user  is  given  the  option  o-f  exiting  CANCOR  without 
calculating  -further  canonical  correlation  statistics. 

Calculate  CANCOR  Statistics.  The  key  to  calculating 
-further  statistics  is  the  solving  o-f  an  eigenvalue  problem; 
in  this  case,  the  eigenvalues  o-F  a  product  o-f  the  partitions 
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o-f  CORRMATRIX.  The  procedure  used  to  estimate  the  polynomial 
roots  (eigenvalues)  is  called  the  de-flation  method.  The  most 
popular  method  -for  estimating  the  largest  eigenvalue  is 
called  the  power  method.  The  de-flation  method  uses  the  power 
method  to  determine  the  largest  eigenvalue  and  eigenvector, 
-factors  out  those  values  -from  the  matrix  (de-flate  the 
matrix),  and  then  reapplies  the  power  method  to  the  de-flated 
matrix.  The  user  has  the  option  o-f  setting  the  Eigenvalue 
routine  stopping  criteria  (Epsilon)  to  any  value  between  0.1 
and  0.000001  inclusive  with  de-fault  at  0.0001. 

To  be  used  by  CANCOR,  it  is  necessary  to  generate  matrix 
'A’  by  multiplying  the  partitions  o-f  CORRMATRIX: 

-1  -1 

A  =  (  R(YY)  ♦  R(YX)  *  R(XX)  *  R(XY)  ) 

Data  mul  ti  col  1  inear  ity  is  indicated  when  either  o-f  the 
inverses  o-f  two  sel-f -correlation  matrices  is  nonexistent.  If 
that  occurs,  the  CANCOR  procedure  is  exited  after  warning  the 
user.  Otherwise,  the  canonical  correlation  (CANCOR),  Wilk's 
Lambda,  and  CHI-Square  statistics  are  calculated  from  the 
eigenvalues  and  then  printed.  Figure  8  is  the  output  using 
the  example  data  and  the  most  accurate  Epsilon  setting.  At 
this  point,  the  user  is  given  the  option  of  exiting  CANCOR 
without  proceeding  with  canonical  variate  cal r'  i at ions. 

Canonical  Variate  Coefficients.  The  next  routine  called 
by  CANCOR  calculates  the  Canonical  Variate  Coefficients 


(ALPHA  t(  BETA  vectors)  for  both  sets  of  variables  (X  Sc  Y) 


Canonical  Wilk's  CHI- 
Nufflber  Eigenvalue  Correlation  Lambda  Square 


0.8323 

0.4980 


0.9123  0.0842  21.0366 
0.7057  0.5020  5.8580 


Figure  8.  CANCORSTATS  Output  Example 

and  prints  them.  It  should  be  noted  that  the  ALPHA’S  are  the 
normalized  eigenvectors.  Calculations  are  as  follows: 


where 


ALPHA  =  1/SQRT<C)  *  ALPHA 


=  ALPHA  *  R(YY)  *  ALPHA 


BETA  =  <1/CANC0R)  *  (R<XX>  *  R<XY>)  *  ALPHA 

where 

CANCOR  3  i’th  Canonical  Correlation 
Figure  9  is  the  output  using  the  example  data. 


where 


CANCOR 


COEFFICIENTS 

FOR 

CANONICAL  VARIABLES  OF 

THE 

FIRST  SET 

CANVAR  1 

CANVAR  2 

XI 

0.5337 

1 . 0923 

Y2 

0.5949 

-1.0602 

COEFFICIENTS 

FOR 

CANONICAL  VARIABLES  OF 

THE 

SECOND  SET 

CANVAR  1 

CANVAR  2 

XI 

0.3821 

1.1619 

X2 

0.7299 

-0.9814 

Figure  9.  Car 

)onic 

al  Variate  Coi 

efficients 

i  0u1 

bput  Example 

Canonical _ J 

i^aria 

te  Scores. 

Once  th 

>e 

E^LPHA  and  BE' 
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coe-f -f icients  have  been  calculated,  CANCOR  calls  a  routine  to 
calculate  the  Canonical  Variate  scores.  The  scores  are  then 


printed  and/or  saved  as  desired  by  the  user.  The  scores  are 
stored  in  a  data  array  the  same  size  as  the  orignal  data.  I-f 
the  user  chooses  to  save  the  scores,  a  properly  formatted 
data  disk  must  be  in  the  non-boot  drive  prior  to  calling  the 
SAVEFILE  routine.  If  printed,  the  scores  are  printed  one  page 
at  a  time  in  the  same  manner  as  in  the  ECHOFILE  routine. 
Figure  10  is  the  output  using  the  example  data. 


CANVAR  1  CANVAR  2 


First 

Second 

First 

Second 

1 

-1.761 

-1.576 

-0.971 

-0.876 

2 

-1.582 

-1.630 

0.353 

0.579 

3 

-0.367 

0.005 

-0.990 

-0.929 

4 

-0.902 

-0.946 

0.786 

1.041 

5 

0.027 

0.109 

0.774 

1.006 

6 

0.563 

1.060 

-1.003 

-0.964 

7 

0.957 

0.533 

0.761 

-0.946 

8 

1.242 

0.636 

-0.570 

0.988 

9 

0.098 

-0. 679 

-0.996 

-1.390 

10 

0.206 

0.266 

2.098 

1.485 

11 

0.277 

0.848 

0.328 

0.012 

12 

1.242 

1.375 

-0.570 

-0.006 

Figure  10.  Canonical  Variate  Scores  Output  Example 


Canonical  Loadings.  The  last  routine  called  by  CANCOR 
calculates  and  prints  the  Structure  Correlations  (canonical 
loadings)  and  the  Indexes  of  Redundancy  (overlapping 
information)  in  the  two  sets  of  variables.  These  values  are 
based  on  the  Canonical  Variate  Coefficients  (ALPHA  Si  BETA), 
the  Eigenvalues,  and  the  Sample  Correlation  Matrix.  Figures 
11  and  12  are  the  outputs  using  the  example  data.  Once  the 


INDEXES 

OF 

REDUNDANCY 

VYl 

s 

0.6524 

VY2 

= 

0. 1076 

0.7601 

o-f 

total 

variance 

VXl 

= 

0.6435 

VX2 

ss 

0. 1130 

0.7565 

o-f 

total 

variance 

Figure  12.  Indexes  o-f  Redundancy  Output  Example 

Indexes  are  printed,  CANCOR  is  exited  and  control  is  returned 
to  the  Top  Level  menu. 


III.  Factor  Analysis 

The  Factor  Analysis  Module  (FACTOR)  starts  by  having  the 
user  designate  a  set  o-f  manifestation  variables.  The  routines 
in  FACTOR  then  aid  the  user  in  looking  for  an  underlying 
pattern  of  relationships  between  members  of  the  designated 
set  of  variables  so  that  a  possible  reduction  to  a  smaller 
set  of  factors  or  components  can  be  done  without  a 
significant  loss  of  accuracy.  The  module  produces  and  outputs 
the  Factor  Loadings,  Commonalities,  Coefficients,  and  Scores 
for  the  designated  set  of  variables.  The  data  in  Table  II  is 
the  data  used  in  the  examples  throughout  this  section. 


Xi 

X2 

X3 

X4 
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2 
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1 

3 
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4 

7 

6 

3 

5 

5 

4 

7 

6 

8 

9 

6 

7 

9 

8 

7 

8 

7 

10 

9 

9 

10 

11 

11 

10 

8 

9 

8 

11 

12 

11 

10 

12 

9 

13 

14 

Table  II.  Example  FACTOR  Data 


Assign  Variables.  When  first  activated  by  the  user, 
FACTOR  calls  ASSI6NVARS  for  variable  selection.  The  user  is 
then  shown  the  current  status  for  each  of  the  fields  and 


asked  whether  to  assign  a  mani-festation,  remove  assignment, 
or  exit  ASSI6NVARS.  Once  entered,  this  routine  will  not  allow 
the  user  to  exit  until  at  least  two  variables  are  assigned. 
This  means  that  there  should  be  at  least  two  variables  in  the 
data  base  be-fore  calling  FACTOR.  The  user  has  the  option  o-f 
making  as  many  changes  as  needed  to  correctly  assign  the 
variables. 

Calculate  Statistics.  The  next  routine  called  by  FACTOR 
calculates  and  prints  the  means  and  standard  deviations  -For 
each  o-F  the  selected  variables.  I-F  a  printer  is  on-line,  the 
results  are  printed  there  as  well  as  on  the  screen.  Figure  13 
is  the  output  using  the  example  data.  At  this  point,  the  user 


VARIABLE 

MEAN 

STANDARD  DEVIATION 

XI 

6.50000 

3.60555 

X2 

7.25000 

2.73446 

X3 

7.66667 

3.60135 

X4 

6.91667 

3.82476 

Figure  13.  Statistics  Output  Example 


is  given  the  option  o-F  exiting  FACTOR  without  proceeding  to 
data  standardization. 

Standardize.  In  preparation  -For  calculating  the  Sample 
Correlation  Matrix,  the  selected  variables  are  standardized 
by  subtracting  the  -Field  mean  and  dividing  by  the  -Field 
standard  deviation.  It  should  be  noted  that  i-F  there  is  only 
one  record,  the  standard  deviations  are  zero,  the  data  values 
become  unde-Fined,  and  are  represented  as  99.9999.  The 


0 
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standardized  values  are  written  over  the  original  values  in 
the  data  array,  but  are  not  automatically  saved  to  disk. 


Generate  Correlation  Matrix.  The  next  procedure  called  by 
FACTOR  generates  and  prints  the  Sample  Correlation  Matrix. 
The  matrix  is  generated  using  the  same  partition  method  as 
the  Correlation  Matrix  generated  in  CANCOR;  in  this  case,  the 
manifestation  variables  are  divided  into  two  equal  or  nearly 
equal  sets  and  the  routine  proceeds  as  before.  Figure  14  is 
the  output  using  the  example  data.  At  this  point,  the  user  is 


XI 

X2 

X3 

X4 

XI 

1 . 0000 

0.8529 

0.9102 

0.9262 

X2 

0.8529 

1 . 0000 

0.8862 

0.7497 

X3 

0.9102 

0.8862 

1 . 0000 

0.8888 

X4 

0.9262 

0,7497 

0.8888 

1 . 0000 

Figure  14.  CORRMATRIX  Output  Example 


given  the  option  of  exiting  FACTOR  without  calculating  any 
factors. 

Factor  Generation  and  Selection.  The  most  significant 
factor  (or  principal  component)  is  associated  with  the 
largest  eigenvalue  and  eigenvector  of  the  matrix  just 
generated.  Once  the  largest  is  extracted,  the  next  largest 
eigenvalue  and  eigenvector  are  associated  with  the  next  most 
significant  factor,  and  so  on.  The  method  used  to  solve  for 
the  eigenvalues  and  eigenvectors  is  the  same  as  used  by 
CANCOR.  The  next  routine  called  by  FACTOR  calculates  and 
prints  the  percents  of  variance  explained  by  each  factor  and 


then  hae  the  user  select  the  number  o-F  -factors  to  maintain 


■for  -further  analysis.  Figure  15  is  the  output  using  the 
example  data  and  the  most  accurate  Epsilon  setting.  The 


FACTOR 

EIGENVALUE 

PCT  OF  VAR 

CUM  PCT 

1 

3.6090 

90.2 

90.2 

2 

0.2606 

6.5 

96.7 

3 

0.0837 

2.  1 

98.8 

4 

0.0467 

1.2 

100.0 

Figure  15.  Factor  Calculation  Output  Example 


user  then  has  the  option  o-f  -factor  selection  based  on 
de-fault,  a  Scree  test,  a  Bartlett  Sphericity  test,  or  user 
selection. 

Pe-f aul t .  I-f  selected  by  the  user,  the  number  o-f 
-factors  maintained  is  the  number  of  eigenvalues  greater  than 

1.0. 

Scree  Test.  If  selected  by  the  user,  SCREE  generates 
a  plot  of  Eigenvalue  Magnitudes  vs.  Factor  Numbers.  The  user 
is  asked  to  visualize  a  line  passing  through  the  right  most 
points  and  extending  to  the  left.  The  most  significant 
factors  are  those  that  do  NOT  fall  on  the  line  PLUS  the  first 
one  that  does.  That  is  the  number  of  factors  that  should  be 
kept.  The  nearly  flat  aspect  of  the  remaining  factors 
indicates  little  improvement  if  more  are  kept. 

Bartlett  Sphericity  Test.  If  selected  by  the  user, 
BARTLETT  calculates  the  CHI -Square  statistic  for  the  Bartlett 
test  of  significance  for  as  many  factors  as  the  user  desires. 


The  user  is  then  asked  to  select  the  number  o-f  si gni-f leant 
factors  that  should  be  kept.  The  test  statistic  is  used  to 
check  the  hypothesis 


Ho:  EIGVAL(r+l)=EIGVAL(r+2)=. . .=EIGVAL(k)=0 
vs. 

Ha:  EIGVAL<r+l)  <>  O;  after  ’r'  tests. 

The  user  should  reference  a  CHI-Square  table  for 
CHI  <  a  ,  (k-r)<k-r-l)  > 

where 

a  *  significance  level 
k  =  number  of  factors 

r  B  number  of  tests  done 

and  reject  the  null  hypothesis  if  the  test  statistic  is 

larger. 

The  routine  will  calculate  one  test  statistic,  then  ask 
the  user  if  more  should  be  calculated.  It  is  up  to  the  user 
to  decide  when  to  stop.  It  will  stop  automatically  after 

making  as  many  calculations  as  there  are  eigenvalues.  The 

routine  will  then  call  USERSELECT,  as  described  below,  to  get 
the  number  of  factors  to  be  kept.  This  test  is  good  for  small 
samples  (n  <  100)  or  for  a  large  number  of  manifestation 

variables  (k  >9). 

User  Select.  If  selected  by  the  user  or  BARTLETT, 
USER8ELECT  asks  the  user  to  enter  the  number  of  factors  to  be 
kept  for  further  analysis.  That  number  must  be  between  1  and 
N  (number  of  eigenvalues)  inclusive. 

Factor  Matrix.  The  next  routine  called  by  FACTOR 


calculates  and  prints  the  -factor  matrix  o-f  Loadings  for  each 
factor  (N  factors),  the  Communal i ties  based  on  the  number  of 
factors  selected  (NS  selected) ,  and  the  Factor  Score 
Coefficients  for  each  of  the  designated  manifestation 
variables  under  analysis.  Figures  16,  17,  and  18  are  the 
outputs  using  the  example  data  and  assume  1  factor  was 
retained  for  analysis. 


FACTOR  MATRIX  USING 

PRINCIPAL  FACTOR (S) 

FACTOR  1 

XI 

0.9717 

X2 

0.9171 

X3 

0.9704 

X4 

0.9391 

Figure  16.  Factor  Matrix  Output  Example 


VARIABLE 

COMMUNAL ITY 

XI 

0.9443 

X2 

0.8412 

X3 

0.9417 

X4 

0.8819 

Figure  17.  Variable  Communal ity  Output  Example 


FACTOR  SCORE 

COEFFICIENTS 

FACTOR  1 

XI 

0.2692 

X2 

0.2541 

X3 

0. 2689 

X4 

0. 2602 

Figure  18.  Factor  Score  Coefficients  Output  Example 


Factor  Scores.  Once  the  Factor  Score  Coe-f -f i ci ents  have 
been  calculated,  FACTOR  calls  a  routine  to  calculate  the 
Factor  Scores.  The  scores  are  then  printed  and/or  saved  as 
desired  by  the  user.  The  scores  are  stored  in  a  data  array 
the  same  size  as  the  original  data.  I-f  the  user  chooses  to 
save  the  scores,  a  properly  formatted  data  disk  must  be  in 
the  non-boot  drive  prior  to  calling  the  SAVEFILE  routine.  If 
printed,  the  scores  are  printed  one  page  at  a  time  in  the 
same  manner  as  in  the  ECHOFILE  routine.  Figure  19  is  the 
output  using  the  example  data.  Once  the  appropriate  option  is 


FACTOR  SCORES: 

CASE 

FACT  1 

1 

-1.7309 

2 

-1.3890 

3 

-0.5577 

4 

-0.6008 

5 

-0.5892 

6 

0.0696 

7 

0.2305 

8 

0.4047 

9 

0.9689 

10 

0.5043 

11 

1.2361 

12 

1 . 4535 

Figure  19.  Factor  Scores  Output  Example 


completed,  FACTOR  is  exited  and  control  is  returned  to  the 


Top  Level  menu 


Before  using  a  blank  disk  to  save  data  files,  it  is 
necessary  to  format  it  in  a  form  that  can  be  used  by  the 


Apple  PASCAL  operating  system.  Once  formatted,  the  disk 
should  be  marked  so  that  it  is  not  formatted  again. 

Formatting  is  done  by  inserting  the  disk  with  side  2  up; 
either  after  booting  or  running  the  package.  Figure  20 
outlines  the  way  to  format  a  disk.  If  the  user  has  inserted 


>C0MhAND:  E<DIT,  R(UN,  F(ILE,  CCOMP,  L(INK,  X (ECUTE. . . 

X 

>EXECUTE  WHAT  FILE? 

APPLE: FORMATTER  <return) 

>APPLE  DISK  FORMATTER  PROGRAM 

>F0RMAT  WHICH  DISK  <4,  5,  9. . 12)  ? 

5  (return)  (Non-boot  drive) 

>N0W  FORMATTING  DISKETTE  IN  DRIVE  5  (If  selected) 
or 

>DESTR0Y  DIRECTORY  OF  BLANK  ?  (Disk  already  formatted) 

Figure  20.  Blank  Disk  Formatting 

a  new  disk  or  answered  ’Y'  to  the  second  response  above,  the 
non-boot  drive  will  make  some  whirring  sounds  for  a  few 
moments,  then  the  ’FORMAT  WHIOl  DISK’  statement  will  appear 
again.  Press  the  (return)  key  to  return  to  the  Command  level 
again  if  no  more  disks  are  to  be  formatted.  NOTE:  If  the 
system  was  booted  with  side  1  up,  the  disk  should  be  turned 
over  prior  to  pressing  the  (return). 


There  are  several  special  routines  available  on  side  2  in 
SYSTEM. FILER.  While  there  are  17  di'f-ferent  commands  available 


in  the  FILER  as  written  by  Apple,  only  5  are  discussed  here. 
Caution  should  be  observed  by  the  unsophisticated  user 
because  the  other  commands  could  contaminate  any  disks 
on-line.  To  exit  any  routines  entered  by  accident,  press  the 
(return)  key  to  return  to  the  command  line. 

To  execute  any  of  the  commands  in  the  FILER,  insert  the 
disk  with  side  2  up;  either  after  booting  or  running  the 
package.  Be  sure  that  a  preformatted  data  disk  is  on-line  in 
the  non-boot  drive.  Figure  21  shows  how  to  execute  the  FILER. 


>command:  e(dit. 

R(UN, 

F(ILE, 

C(OMP,  L(INK, 

X (ECUTE, . 

F 

>Filer:  G,  S,  N, 

L, 

R, 

C,  T, 

D,  Q  (1.1) 

<command>  (Where 

< command > 

=  L,  R,  C,  K, 

or  B) 

Figure  21.  SYSTEM. FILER  Execution 


Once  selected,  each  of  these  commands  carries  out  a  different 
procedure. 

LdST  DIRECTORY.  If  selected,  L(ist  works  as  follows: 

>Dir  listing  of  ?  BLANK:  (return) 

If  BLANK:  is  on-line,  the  FILER  will  list  the  names  of  all 
data  files  on  the  disk, 

L 


the  size  of  the  file  in  disk 


segments,  and  a  date.  I-f  BLANK:  is  not  -found,  a  message  is 
displayed  and  the  FILER  command  line  will  then  return. 


R (EMOVE.  I-f  selected,  R(emove  works  as  -follows: 

>Remove  ?  BLANK: <-fi  lename>.  TEXT  (return) 

>BLANK:  <-f  i  lename>.  TEXT  — >  removed 

XJpdate  directory?  (Y/N) 

I-f  the  -file  is  -found,  FILER  repeats  the  -filename  to  veri-fy 
that  it  is  the  correct  one  to  remove.  I-f  the  user  responds 
with  a  *Y*,  the  FILER  will  remove  the  designated  -filename 
•from  the  directory  and  that  -file  is  considered  erased.  (The 
sophisticated  user  can  recover  the  -file  with  the  li(AKE 
command.)  I-f  the  -file  is  not  -found,  a  message  is  displayed 
and  the  FILER  command  line  will  then  return. 

C(HANBE.  I-f  selected,  C(hange  works  as  -follows: 

>Change  ?  BLANK: <-fi lename>. TEXT  (return) 

>Change  to  what  ?  BLANK:<new-f ilename>.TEXT  (return) 

I-f  the  -file  is  -found,  the  FILER  will  change  the  name  o-f  the 
designated  <-filename>  to  <new-f ilename>.  I-f  the  -file  is  not 
-found,  a  message  is  displayed  and  the  FILER  command  line  will 
then  return.  NOTE:  The  <new-f i lename>  must  be  10  or  less 
characters  long  and  start  with  a  letter. 

K  (RUNCH.  I-f  selected,  K(runch  works  as  -follows: 

>Crunch  ?  BLANK:  (return) 

>From  end  o-f  disk,  block  280  ?  (Y/N) 

I-f  BLANK:  is  on-line  and  'Y'  was  selected,  K(runch  will  move 
the  -files  -forward  and  all  the  available  space  will  be  at  the 


.  ■  . 


%.■  sJ-.  -w: 


end  o-f  the  disk.  Typing  an  *N*  will  cause  the  prompt 
>Starting  at  block  # 

requiring  the  user  to  input  a  number  -from  1  to  280.  This 
option  should  NOT  be  used.  A-fter  BLANK:  is  krunched,  the 
FILER  command  line  will  then  return. 

0 <UIT.  When  selected,  Q(uit  will  return  control  to  the 
top  level  command  line  shown  above.  NOTE:  I-f  the  system  was 
booted  with  side  1  up,  the  disk  should  be  turned  over  prior 
to  quitting;  otherwise  side  2  should  remain  up. 
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VI 


The  PASCAL  Statistical  Procedures  Package  (PSPP)  was 
written  on  the  Apple  lie  microcomputer  using  the  Apple  PASCAL 
language  and  operating  system.  It  should  be  executable  on  the 
Apple  II  or  Apple  II->-  (with  language  card  installed),  and 
Apple  III  computers  (i-f  the  source  is  recompiled). 

The  package  is  composed  o-F  a  host  program  stored  in  -File 
PSPP. CODE,  4  regular  units  stored  in  the  -File  MYLIB.CODE,  and 
16  intrinsic  units  stored  in  the  -File  SYSTEM. LIBRARY.  It 
should  be  noted  that  several  intrinsic  units  normally  stored 
in  the  SYSTEM. LIBRARY  were  removed  because  they  are  not  used 
by  PSPP,  The  Apple  PASCAL  operating  system  files 
SYSTEM. APPLE,  S YSTEM . PASCAL ,  and  SYSTEM. MI SC INFO  are  on  both 
sides  o-F  the  program  disk.  Operating  system  -Files 
SYSTEM. FILER,  FORMATTER , CODE ,  and  FORMATTER . DAT A  are 
additionally  stored  on  side  2. 

There  are  a  total  o-F  163  new  procedures,  in  addition  to 
those  intrinsic  procedures  by  Apple  in  the  SYSTEM. LIBRARY. 
The  text  files  for  these  procedures  take  over  218,000  bytes 
of  storage  space.  Compiled,  they  take  up  almost  100,000  bytes 
of  storage  space.  By  using  the  PASCAL  unit  structures,  the 
most  core  used  by  the  program  at  any  one  time  is  about  21,000 
bytes.  There  are  more  than  17,000  bytes  used  for  data 
storage.  The  maximum  user  available  space  in  the  Apple  He  is 
39,900  bytes  of  core  when  the  SWAPPING  option  is  set.  The 


Apple  PASCAL  operating  system  -files  necessary  to  execute  the 
program  take  up  84  blocks  o-f  diskette  space.  The  compiled 
versions  o-f  the  host  program  and  the  two  libraries  take  up 
215  blocks.  There  are  274  blocks  available  -for  use. 

The  package  was  put  together  by  -first  compiling  the 
intrinsic  units  that  did  not  use  any  others  and  storing  them 
in  the  SYSTEM. LIBRARY.  Next,  intrinsic  units  that  re-ferenced 
others  were  compiled  and  stored.  Regular  units  that  did  not 
use  any  others  were  then  compiled  and  stored  in  MYLIB.CODE. 
Regular  units  that  re-ferenced  others  could  then  be  compiled 
and  stored.  Lastly,  a-fter  all  units  (intrinsic  and  regular) 
were  compiled  and  stored  in  their  appropriate  libraries,  the 
host  program,  PSPP,  was  compiled  and  linked  with  the  regular 
units.  Because  the  compiled  versions  more  than  -filled  the 
availab^?  space  on  a  single  diskette,  both  sides  were  used 
with  the  Apple  PASCAL  operating  system  files  necessary  for 
special  non-program  features  stored  only  on  side  2. 

The  package  structure  is  outlined  in  Figure  22.  The  boxes 
stand  for  procedures  called  by  the  normal  program  flow  while 
the  ovals  are  options  the  user  has  a  choice  of  in  the  box 
just  above  them  in  the  tree.  On  the  DATA  side  of  the  tree, 
once  a  procedure  is  completed,  control  ’backs  up’  to  a  higher 
level  menu  until  the  user  is  done.  On  the  statistical  side, 
control  proceeds  toward  the  end  of  the  procedure  with  several 


opportunities  to  exit  to  the  top  level  (PSPP)  menu. 


SPSS  Output  o-F  Example  CANCOR  Data 


VARIABLE 


MEAN 

6.0000 

5.7500 

6.3333 

6.4167 


STANDARD  DEV 

2.4863 
2.3789 
2.4246 
1 . 9752 


CORRELATION  COEFFICIENTS 


Y1 

Y2 

XI 

X2 

Y1 

1 . 00000 

. 56869 

. 84449 

. 64789 

Y2 

. 56869 

1.00000 

. 47284 

. 87546 

XI 

. 84449 

. 47284 

1 . 00000 

. 57579 

X2 

. 64789 

. 87546 

. 57579 

1 . 00000 

NUMBER 


EIGENVALUE 

. 83232 
. 49799 


CANONICAL 

CORRELATION 

.91232 
. 70568 


WILK  S 
LAMBDA 

.08418 

.50201 


CHI-SQUARE 

22,27354 

6.20223 


COEFFICIENTS  FOR  CANONICAL  VARIABLES  OF  THE  FIRST  SET 

CANVAR  1  CANVAR  2 

Y1  .53370  -1.09232 

Y2  ,59498  1.06019 

COEFFICIENTS  FOR  CANONICAL  VARIABLES  OF  THE  SECOND  SET 

CANVAR  1  CANVAR  2 


. 38209 
. 72995 


-1.16189 

.98140 
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CASE  CANVAR  1  CANVAR  2 


FIRST 

SECOND 

FIRST 

SECOND 

1 

-1.76107 

-1.57596 

.97107 

. 87582 

2 

-1.58187 

-1.63034 

-.35326 

-.57944 

3 

-.36678 

. 00546 

. 99008 

. 92877 

4 

-.90245 

-.94561 

-.78625 

-1.04100 

5 

. 02707 

.  10866 

-.77358 

-1.00570 

6 

. 56274 

1 . 05974 

1 . 00275 

. 96407 

7 

. 95660 

. 53260 

-.76091 

. 94642 

8 

1.24216 

. 63580 

. 56976 

-.98804 

9 

. 09798 

-.67927 

. 99642 

1 . 39032 

10 

. 20627 

. 26625 

-2.09791 

-1.48490 

11 

.27718 

. 84777 

-.32791 

-.01199 

12 

1.24216 

1.37491 

. 56976 

. 00566 

STRUCTURE  CORRELATIONS 


Y1 

Y2 

YCANVARl 

.8721 

-.4894 

YCANVAR2 

.8985 

.4390 

XI 

X2 

X CANVAR 1 

.8024 

-.5968 

XCANVAR2 

.9500 

.3124 

VARIABLE 


MEAN 


STANDARD  DEV 


XI 

6.5000 

3.6056 

X2 

7.2500 

2.7345 

X3 

7.6667 

3.6013 

X4 

6.9167 

3.8248 

CORRELATION  COEFFICIENTS 


XI 

X2 

X3 

X4 

XI 

1 . 00000 

. 85292 

.91015 

.92621 

X2 

. 85292 

1 . 00000 

. 88622 

.74971 

X3 

.91015 

. 88622 

1 . 00000 

. 88879 

X4 

.92621 

.74971 

. 88879 

1 . 00000 

FACTOR 

EIGENVALUE 

PCT  OF  VAR 

CUM  PCT 

1 

3. 60903 

90.2 

90.2 

2 

. 26059 

6.5 

96.7 

3 

. 08369 

2.  1 

98.8 

4 

. 04669 

1.2 

100.0 

FACTOR  MATRIX  USING  PRINCIPAL  FACTOR 


FACTOR 

XI 

.97173 

X2 

.91714 

X3 

. 97043 

X4 

.93909 

VARIABLE  COMMONALITY 


XI  .94426 
X2  .84115 
X3  .94173 
X4  .88189 


Si 

957,987 

3.00000 

57 

421.048 

53.0000 

se 

807.440 

17.0000 

5< 

724.578 

4.00000 

iO 

708,572 

13.0000 

it 

1094.20 

1.00000 

i2 

84.3832 

l.OOOOC 

i3 

332.511 

8.00000 

44 

2500.44 

3.00000 

43 

40.2334 

4.00000 

44 

1048.34 

14.0000 

47 

401.448 

2.00000 

48 

2253.70 

17.0000 

44 

1315.44 

4.00000 

70 

24,1445 

3.00000 

71 

1441.28 

8.00000 

72 

331.440 

15.0000 

73 

484.303 

5.000CO 

74 

2437,51 

9.00000 

75 

2084.17 

7.00000 

74 

785.4<i0 

0.00000 

77 

475.113 

3.00000 

78 

2214.27 

1.00000 

7? 

887.103 

24.0000 

80 

3840.45 

17.0000 

81 

1932.12 

1.00000 

82 

1157.38 

13.0000 

83 

545.000 

9.00000 

84 

1991,74 

5,00000 

83 

2028.74 

2.00000 

84 

3425.42 

4.00000 

87 

780.434 

8.00000 

88 

1083,73 

I. 00000 

84 

1497.49 

4.00000 

40 

4094.44 

20.0000 

41 

234.093 

7.00000 

42 

1175.53 

5.00000 

43 

2413.84 

15.0000 

44 

3l.8«72 

12.0000 

45 

332.294 

7,00000 

44 

518.027 

8.00000 

97 

1054.32 

28.0000 

98 

945.087 

3.00000 

99 

1334.21 

2,00000 

100 

1579.41 

23.0000 

101 

159.325 

3.00000 

102 

101. sis 

1.00000 

103 

979.442 

15.0000 

104 

2848.71 

3.00000 

105 

3328.74 

0.00000 

104 

1198.12 

13.0000 

107 

305.148 

10.0000 

108 

544.141 

3.00000 

109 

2388.14 

2.00000 

110 

1524.71 

25.0000 

111 

4117,59 

4.00000 

112 

2954.08 

2.00000 

113 

934.728 

18.0000 

114 

430.484 

1.00000 

115 

1435.48 

17.0000 

47.0000 

0.0384C 

118.000 

0.04880 

504.000 

0.14880 

141.000 

0.03370 

185.000 

0.09440 

375.000 

0.14270 

228.000 

0.11390 

254.000 

0.11440 

110.000 

0.31540 

37.0000 

0.07900 

214.000 

0.24110 

85.0000 

0.08890 

183.000 

0.38980 

554.000 

0.24940 

144.000 

0.14050 

149.000 

0.21700 

39.0000 

0.03300 

34.0000 

0.14940 

140.000 

0.31180 

317.000 

0.54090 

425.000 

0.12460 

49.0000 

0.09610 

133.000 

0.13680 

324.000 

0.14290 

74.0000 

0.13730 

101.000 

0.07970 

257.000 

0.04400 

95,0000 

0.04440 

245.000 

0.15520 

448.000 

0,23870 

104.000 

0.31530 

271.000 

0.19400 

U.OOOO 

0.22400 

139.000 

0.17920 

188.000 

0.35350 

150.000 

0.04440 

238.000 

0.13250 

309.000 

0.30950 

270.000 

0.15770 

214.000 

0.28920 

455.000 

0.24120 

110.000 

0.27800 

121.000 

0.24050 

99,0000 

0.12720 

249.000 

0.28020 

340.000 

0.15920 

193.000 

0.24350 

245.000 

0.34870 

109,000 

0.33180 

349,000 

0.50170 

104.000 

0.27900 

155.000 

0.03070 

244.000 

0.31100 

328.000 

0.47340 

99.0000 

0.11320 

91.0000 

0.38940 

280.000 

0.43940 

344.000 

0.22530 

413.000 

0.21190 

34.0000 

0.29440 

1.00000 

11,09)2 

2.00000 

11.1070 

4.00000 

11.2590 

17,0000 

11.2823 

5.00000 

11.3879 

7.00000 

11.4754 

1.00000 

11.5341 

0.00000 

11.5965 

0.00000 

11.4101 

2.00000 

11.4272 

24.0000 

11.4405 

2.00000 

11.4909 

13.0000 

11.7670 

14. 0000 

11.8338 

1.00000 

11.856C 

9.00000 

11.8758 

21.0000 

11.8957 

3.0000C 

11.8979 

13.0000 

11.9229 

3.00000 

11.9672 

2.00000 

12.0679 

2.00000 

12.06:7 

l.OOOOC 

12.1065 

1.00000 

12.1638 

17,0000 

12.1852 

14.0000 

12,2046 

7.00000 

12,3195 

15.0000 

12,3717 

4.00000 

12.5238 

19.0000 

12.5722 

1.00000 

12.5908 

1.00000 

12.4297 

25.0000 

12.4721 

0.00000 

12.4905 

3,00000 

12.7302 

2,00000 

12.7747 

0.00000 

12.8340 

7.00000 

12.8512 

11.0000 

12.9304 

3.00000 

13.0122 

11.0000 

13.0830 

9.00000 

13.0948 

10.0000 

13.1320 

17.0000 

13.2084 

25.0000 

13.2470 

0.00000 

13.3175 

5.00000 

13.4075 

11.0000 

13.4154 

3.00000 

13.4343 

35.0000 

13.4853 

1.00000 

13.4918 

0.00000 

13.5434 

3.00000 

13.5414 

1. 00000 

13.5750 

5.00000 

13.4179 

13.0000 

13.4457 

2.00000 

13.7259 

7.00000 

13.8910 

13.0000 

13.9441 

1.00000 

13.9545 
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FILE  bi;cincor: 

VARIABLE  KAN  STANDARD  DEVIATION 


Tot  I/O 

1287.09 

1104.71 

Linii 

10.4519 

9.7708C 

TuroAr 

0.1802! 

0.11840 

Hrdair 

188. 42i 

125.494 

Cirdl 

10.2577 

10.4890 

Dtpirt 

12.2921 

2.28627 

CORRELATION 

COEFFICIENTS; 

Tot  1/0 

Lints 

TurnAr 

Hrdair 

Cards 

Tot  I/O 

1.0000 

-0.0577 

0.4789 

-0.1257 

0.1686 

Lint! 

-0.0577 

1.0000 

-0.1062 

-0.0751 

-0.0951 

TuroAr 

0.4789 

-0.1042 

1.0000 

0.2505 

0.1543 

Hrdiir 

-0.1257 

-0.0751 

0.2505 

1.0000 

-0.0114 

Cirdc 

0.1486 

-0.0951 

0.1545 

-0.0114 

l.OOOC 

DtpiM 

0.0717 

-0.0963 

0.2181 

0.0022 

0.1240 

NUMBER  EISENVALUE 


canonical 

correlation 


NILF’S 

LAMBDA 


CHI- 

SSUARE 


0.1835 

O.OABR 

0.0000 


0.4285 

0.2211 

0.0025 


0.77A4  40.0755 
0.9511  7.9484 
1.0000  0.0008 


COEFFICIENTS  FOR 

CANONICAL 

VARIABLES  OF  THE  FIRST  SET 

CANVAR  1 

CANVAR  2 

CANVAR  5 

Tot  I/O 

0.4556 

0.9152 

0.1814 

Lints 

0.2114 

-0.3255 

0.9278 

TurnAr 

-1.0855 

0.0230 

0.5442 

COEFFICIENTS  FOR 

CANONICAL 

VARIABLES  OF  TK  SECOND  SET 

CANVAR  1 

CANVAR  2 

CANVAR  5 

Nrd«ir 

-0.8650 

-0.3754 

-0.5383 

Cards 

-0.1511 

0.8041 

-0.5935 

»tpart 

-0.4727 

0.5451 

0.8118 

STRUCTURE  CORKLATIDNS: 

Tot  I/O 

Lints 

TurnAr 

TCVl  0.1226 

0.9450 

0.5054 

YCV2  0.2889 

-0.5804 

0.8785 

TCV5  -0.7927 

0.4958 

0.5544 

Drpirt 

0.0717 

-D.098J 

0.2181 

0.0022 

0.1240 

1.0000 


ICVl 

ICV2 

«CV3 


INDEIES 


Hrit»ar 

CirOs  Dipirt 

-0,8425 

-0.3838  -0.3296 

-0.1798 

0.6537  -O.IBe’ 

-0.4909 

0.4440  0.7375 

OF  REDlMDONCy; 

VTl  « 

0.0445 

972  • 

0.0209 

V73  « 

O.OOOC 

0.0454  oF  total  variince 

VII  ■ 

0.0422 

VI2  « 

0.0178 

VI3  • 

O.OOOC 

O.oeoo  o<  totil  viriincr 


SPSS  Output  ot  CANCOR  Validation  Data 


VARIABLE 

MEAN 

STANDARD  DEV 

Tot  I/O 

1287.0926 

1104.7059 

Lines 

10.6319 

9.7708 

TurnAr 

.  1802 

.1184 

Hrdwar 

188.6258 

125.4944 

Cards 

10.2577 

10.6890 

Depart 

12.2921 

2.2863 

CORRELATION  COEFFICIENTS 

Tot  I/O 

Lines  TurnAr 

Hrdwar 

Cards 

Depart 

Tot  I/O 

1 . 00000 

-05771  .47888 

-. 12574 

.  16862 

.07170 

Lines 

-.05771 

1.00000  -.10617 

-.07507 

-.09507 

-.09832 

TurnAr 

. 47888 

-.10617  1.00000 

. 25053 

.  15427 

.21815 

Hrdwar 

-. 12574 

-.07507  .25053 

1 . 00000 

-.01145 

.00216 

Cards 

. 16862 

-.09507  .15427 

-.01145 

1 . 00000 

. 12400 

Depart 

.07170 

-.09832  .21815 

.00216 

.  12400 

1 . 00000 

NUMBER 

EIGENVALUE 

CANONICAL 

CORRELATION 

WILK  S 
LAMBDA 

CHI-SQUARE 

1 

. 18347 

. 42834 

. 77659 

40.20171 

2 

.04891 

.22115 

.95109 

7.97344 

3 

.00001 

. 00227 

. 99999 

. 00082 

COEFFICIENTS  FOR  CANONICAL  VARIABLES  OF  THE  FIRST  SET 

CANVAR  1  CANVAR  2  CANVAR  3 

Tot  I/O  -.65356  .91517  .18156 

Lines  -.21157  -.32532  .92783 

TurnAr  1.08327  .02300  .36616 


COEFFICIENTS  FOR  CANONICAL  VARIABLES  OF  THE  SECOND  SET 

CANVAR  1  CANVAR  2  CANVAR  3 

Hrdwer  .86301  -.37543  -.33825 

Cards  .13108  .80413  -.59326 

Depart  .47275  .36511  .81168 


FACTOR  Validation  Data 


ECMICHEC»  Of  CURRENT  DATAFILE; 


F’^CTOR 


FILE  MgFictor; 


VARIAILE 

NEAR 

STANOARI  DEVIATION 

Dili  I/O 

I20i.l0 

1035.00 

Arrive 

12.1119 

2.26339 

CPU  Ueed 

123.000 

115.763 

Cirdt 

10.2577 

10.6090 

I/O  Tim 

10.9944 

72.2710 

Li  net 

10.4319 

9.77000 

CORRELATION 

COEFFICIENTS: 

Dili  I/O 

Arrive 

CPU  Used 

Cirdi 

Dili  I/O 

l.OOOC 

0.0464 

-0.1341 

0.1605 

Arrive 

0.0464 

-0.0065 

0.1172 

CPU  Uied 

-0.1341 

-0.0065 

0.0132 

Cirdi 

0.1605 

0.1172 

0.0132 

1.0000 

I/O  Tiee 

0.9502 

0.0590 

-0.1415 

0. 1629 

Linet 

-0.0600 

-0.0930 

-0.0923 

-0.0951 

FACTOR 

EI6ENVALUE 

PCT  OF  VAR 

CUN  PCT 

1 

2.0515 

34.2 

34.2 

2 

1.2007 

20.0 

54.2 

3 

0.9769 

16.3 

70.5 

4 

0.8771 

14.6 

85.1 

S 

0.0453 

14.1 

99.2 

6 

0.0403 

0.8 

100.0 

3  <ictor(il  citotrn  to  continue  FACTOR  inalyoii  «itti. 
Thii  tipliini  70. SI  of  ttie  viriinci. 


FACTOR  AATRIl  USIAS  PRINCIPAL  FACTOR(S); 


FACTOR  1 

FACTOR  2 

FACTOR  3 

tiik  I/O 

0.9651 

0.0820 

0.1588 

Arrive 

0.1417 

-0.5337 

-0.6534 

CPU  Uted 

-0.2422 

-0.4529 

0.6481 

Cirdi 

0.3243 

-0.4987 

•0.1614 

1/0  TiH 

0.9638 

0.1105 

0.1323 

Linn 

-0.0860 

0.6640 

-0.2475 

VARIAILE  COmUNALITT 


I/O  Tiot 

c.«o: 

0.059C 

-0.M15 

0.li29 

l.OOOC 

-0.0105 


lilk  I/O 


0.n33 


VARIABLE 


MEAN 


STANDARD  DEV 


Disk  I/O 
Arrive 
CPU  Used 
Cards 
I/O  Time 
Lines 


1206.0982 

12.1119 

123.0798 

10.2577 

80.9944 

10.6319 


1035.8035 

2.2634 

115.7630 

10.6890 

72.2711 

9.7708 


CORRELATION  COEFFICIENTS 


Disk  I/O 
Arrive 
CPU  Used 
Cards 
I/O  Time 
Lines 


Disk  I/O 

1 . 00000 
.04641 
13413 
. 16847 
.95021 
-.06081 


Arrive 

.04641 
1 . 00000 
-.00655 
.11718 
. 05897 
-.09376 


CPU  Used 

-. 13413 
-.00655 
1 . 00000 
.01317 
-. 14151 
-.09227 


Cards 

. 16847 
.11718 
.01317 
1 . 00000 
. 16294 
-.09507 


1/0  Time 

-95021 
. 05897 
-. 14151 
. 16294 
1 . 00000 
-.01050 


FACTOR  EIGENVALUE 


PCT  OF  VAR  CUM  PCT 


1  2.05151 

2  1 . 20067 

3  . 97675 

4  . 87709 

5  . 84568 

6  . 04829 


34.2 

34.2 

20.0 

54.2 

16.3 

70.5 

14.6 

85.  1 

14.  1 

99.2 

.8 

100.0 

FACTOR  MATRIX  USING  PRINCIPAL  FACTOR (S) 


FACTOR 

Disk  I/O 

.96501 

Arrive 

. 14199 

CPU  Used 

-.24205 

Cards 

. 32453 

I/O  Time 

. 96373 

Lines 

-.08620 

FACTOR  2 

FACTOR 

-.08189 

-. 15874 

.53534 

. 65344 

. 45322 

-.64814 

. 49866 

.  16117 

-.11038 

-. 13229 

-.66417 

.24697 

Li  nes 

.06081 
. 09376 
. 09227 
. 09507 
.01050 
. 00000 
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VARIABLE 


COMMUNAL I TY 


Disk  I/O  .96314 

Arrive  ,73374 

CPU  Used  . 68409 

Cards  • 37996 

I/O  Time  ,95846 

Lines  .50955 


FACTOR  SCORE  COEFFICIENTS 

FACTOR  1 

Disk  I/O  ,47039 

Arrive  ,06921 

CPU  Used  -.11799 

Cards  . 15819 

I /O  Ti me  . 46977 

Lines  -.04202 


FACTOR  2  FACTOR  3 

-.06820  -.16252 

. 44587  . 66899 

.37747  -.66357 

.41532  .16501 

-.09193  -.13544 

-.55317  .25285 


PROS'^A"  PSPF; 


USES 

TRANBSEND,  APPlEE'J'^P,  MA!N_UNIT,  MU_A.  MU_P,  M'J_C,  M'J_D, 

muIe.  Hli_F,  MU_S, 

(*  Units  in  BYSTEF..  library  *)  MU_  I  ,  MU_J,  MU_l-  , 

(**J  PSPF : MVu IP. COPE  «)  SET_UF,  p*TA_MDD. 

CANC0F_MCD,  FArTOF_MOn: 

<*  Inten-.al  Procedure  •’ 

(«•«*•«*•••••••••«•«••«**««•«••*««••••*••««•««*«•«•*•••*«••«««•***•* 

PRDEEDURE  TOPMEMJ  ( PR  1  MTER :  BOOi_EAN )  ; 


(•  ♦) 

(*  This  procedune  displays  a  menu  user  options  *) 

(*  and  calls  the  desinetj  statistical  module.  *' 

<«  ♦ ) 


VAP 

OPT:  CHAR;  (*  Statistical  option  to  run  ) 

DONE:  BQ0._EAN;  (*  Exit  PSPF  designator  «> 

BEGIN 

<*SR  MAIN_UNIT  *)  («  Retain  UNIT  in  memory  ♦) 

DONE: "FALSE i 

WHILE  NOT  (DONE)  DO 
BEGIN 

WFITELN(CHF  (12) , ’  ’  :  16, CHR ( 15)  ,  ’  PASCAL 

'STATISTICAL  PROCEDURES  PACKAGE 
CHR (14)); 

G0T0XY(0, 10) ; 

WR ITELN ( ’ Sel ect  desired  modul e : ’ , CHR ( 1 3) ) ; 
WRITELN(’  I  -  Data  File  Preparation’); 

WRITELN(’  2  -  Canonical  Correlation’); 

WRITELN(’  3  -  Factor  Analysis’); 

WRITELN(’  4  -  Exit  PSPF’); 

eETOPTION(OPT)  ; 

WHILE  (OPT^’l’)  OR  (DPT>’4’)  DO 
GETOPTION(OPT) ; 

CASE  <OPT)  OF  (*  Call  appropriate  module  *) 

’  1 ’  :  DAT AMODULE (DATA, SPECS  1 , SPECS2, PRI NTER ) ; 
•2’ ;  CANCOR (DATA, SPECS 1 , SPECB2 , PR  I NTEF )  ; 

•3’ :  FACTOR (DATA, SPECSl ,SPECS2, PRINTER) ; 

’4’:  DONE; "TRUE; 

END;  (*  End  o-f  CASE  *) 

END;  («  End  o-f  WHILE  loop  *) 

;  (•  End  o-f  TOP  MENU  *) 


END 


(* 

(« 

<* 


M^ln  body  o-f  PEPF" 


«  ) 
*  ) 
*  ) 


BEGIN 

(♦•N+«)  (*  UNIT  no-load  option  *) 


STARTUP ( PR I NTER / >  <*  Display  cover  *) 

IF  (PRINTER'  THEN 

REWR 1 TE ( PTR , ’ PR  1 NTER :  ’ ) ;  (*  Turn  on  printer  *) 

T0PI1ENU<PRINTER)  ;  (*  Select  module  •) 

WRITE (CHR ( 12) ) ; 

GOTOXy (28, 13)  ; 

WRITE (’Done  at  last.  .  .  '  ’); 

END. 

(••••««••••••«••••*•«*•*«•*«•••••••«*••••«••*•««•••*•«••*•••••••«•••) 


(*«5+* ) 


UNIT  SET_UP; 

INTERIM  ACE 

USES  APPL.ESTURF,  MAIN_UNIT; 

PROCEDURE  STARTUP (VAR  PRINTER: BOOLEAN)  ; 
IMPLEMENTATION 


<♦  Main  body  o+  UNIT  *) 

1 

PROCEDURE  STARTUP; 

(••»•*•••«••»•••«»««•*«•»•••**««»•«»•»«•••«»•••«««••»*«•*«*«•••••*•«) 
<*  * ) 

(*  ThiB  procedure  displays  a  cover,  gives  a  prograrr,  *) 

(*  overview  i -f  desired,  then  requests  the  user  *) 

(*  input  the  limits  on  the  size  o-f  the  data  +ile.  *) 

<*  • ) 

VAR  OPT:  CHAR;  <*  Menu  option  •) 

(••••••••••••••••••as**************!.********************************) 

(*  Internal  Procedures  *) 

(•••••••••••••••••••••a*********************************************) 

PROCEDURE  DRAWSCREEN; 

VAR 

I,  (*  Iteration  counter  a) 

POS,  (•  Either  X  or  Y  position  a) 

pitch:  (a  Pitch  of  musical  note  a) 

integer; 

line:  (•  Line  o^  text  to  display  a) 

STRING; 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 
<a  Procedures  internal  to  DRAWSCREEN  a) 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 


PROCEDURE  DISPLAYl; 

BEGIN 

FOB  l:-l  TO  LENGTH(LINE)  DO 
BEGIN 

WRITE (COPY (LINE, I, 1) , ’  ’)J 
NOTE(PITCH, 10) 1 
PI TCH: -PITCH* 1 J 

END; 

END; 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

PROCEDURE  DISPLAY?; 

BEGIN 

FOR  l:-l  TO  LENGTH(LINE)  DO 


BEGIN 

WRITE (COPY (LINE, I , 1 ), ’  ’)} 
NOTE (PITCH, 10' ; 
pitch; =P1TCH-1 ; 

END; 

END; 


( 


PROCEDURE  DISPI.AY3; 

BEG  I  N 

FOR  I:=l  TO  length (LINE)  DO 
BEGIN 

WRITE (COPY (LINE, 1,1)); 
NOTE (PITCH, 10) ; 
pitch:=pitch-i ; 

end; 

END; 


<*  Main  body  o-f  DRAW  SCREEN  *) 

(••••«««»«•••«••«•••••••«•«•••••«•••««•*«••••••«••«••••••••••«**••*« ) 


BEGIN 

(•*R  APPLESTUFF  *)  (•  Retain  UNIT  in  memory  •) 

WRITElN (CHR ( 12) ) ; 

pitch:-i; 

POS:el;  (*  Draw  box  around  screen  •) 

FOR  l:=l  TO  20  DO 
BEGIN 

GOTOXY  <P0S,0) ; 

WRITE  (’•’)  ; 

POS:  »=P0S*4; 

END; 


POS: -2; 

FOR  l:=l  TO  10  DO 
BEGIN 

GOTOXY (77, POS) ; 
WRITE (’*’ ) 5 
POS: -P0S*2; 

END; 

POS: -73: 

FOR  l:-l  TO  19  DO 
BEGIN 

GOTOXY (POS, 20) ; 
WRITE (’*’); 
=>0S:-P0S-4; 

END; 

P0S:-i8; 

FDR  I:>=1  TO  9  DO 
BEGIN 

GOTOXYd.POS)  ; 
WRITE ('*’ ) I 
P0S:-PCE-2l 

END; 
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WRITE (CHR ( 15) ) ; 

LINE: =’ PASCAL  STATISTICAL 


LINE: “’PROCEDURES  PACKAGE’; 
WRITE  (CHR  (M'  )  ; 

LINE: =’ (PSPP) ’ ; 

LINE: POR’ ; 

line:  “’MICROCOMPUTER’  : 

L INE  :  =  ’  Pr  ogi'ammed  by'’; 
LlNE:“’D«vid  P.  Kunkcl ’ ; 

END;  (•  End  of  DRAW  SCREEN  *) 


GDTOXY (21 , 3) ; 
BDTOXV (22,3) ; 
GDTOXY (21 , 5)  ; 
GDTOXY (22,5) ; 


WRITE  (  ’  ’  )  ; 

DlSPi^AYl  ; 

write:’  ’ ) ; 

DISPlAYI ; 


GDTOXY (34, 7) ; 
GDTOXY (37, 10) ; 
GDTOXY (27,12); 
GDTOXY (33, ; 5) ; 
GCTDXY (32,17); 


DISPLAY] ; 

display  1 ; 
display?; 

display:,; 
display  3: 


( 


PROCEDURE  overview; 


(••••«•«••••••»***•••«•••••••«••«•••••••••••••••«••••«>•••««••*•*••• ) 

(*  Procedures  internal  to  OVERVIEW  *) 


PROCEDURE  PAGEl; 


BEGIN 

GDTOXY (0,5) ; 
WRITELNCThjs  pac 
’Statist) 
WRITELNCThe  -foil 
CHR (13) ) 


kage  does  Multivariate  ’, 
cal  anal ysi s. ' , CHR ( 13) ) ; 
OMing  modules  are  available: 


WRITELN ( ’ 
WRITELNC 
WRITELN ( ’ 
WRITELN ( • 
WRITELN ( • 
WRITELN ( ’ 
WRITELNC 
WRITELN(’ 
END;  (*  End 


1  -  Data  Pile  preparation’); 


of 


2  - 
3  - 
PAGE 


a  -  Create  a  new  data  Pile 
b  -  Save  a  Pile  to  disk’); 
c  -  Load  a  Pile  Prom  disk’ 
d  -  ModiPy  data  in  a  Pile’ 
c  -  Echo-check  data  in  a  P 
Canonical  Correlation  anal 
Factor  analysis’); 

1  *) 


’ ) ; 

> ; 

) ; 

lie'); 
ysi s’ ) ! 


( 


) 


PROCEDURE  PAGE2; 

BEGIN 

GOTOXY (0,3) ; 

WRITELN (’ Data  Pile  speci P i cat i ons  are  NOT  under  ’, 
’user  control CHR ( 13) ) ; 

WRITELN(’The  Pollowing  criteria  exist:’); 

WRITELNC  1  -  Upper  limit  oP  ’.MAXSIZE, 

’  Pields  per  record’); 

WRITELNC  2  -  Upper  limit  oP  ’.MAXREC, 

’  records  in  Pile’); 

WRITELNC  3  -  All  records  ’  ,  CHR  (  1 5)  ,  ’  MUST  ’  , 

CHR (14),’  be  numer i c ’ , CHR (13), CHR (13)); 

WRITELNCThere  are  two  types  oP  user  inputs:’, 

CHR (13)); 

WRITELN (’  1  -  When  asked  to  ’’ENTER’’  a  value,  ’, 

'you  should  type  your’); 

’  response,  then  press  the  ’ , 

’RETURN’ , CHR (14) , ’  key.’); 


WRITELN ( 


CHR (15) 


WRITELN ( 


2  —  Uhen  acWed  to  ’’PICK’’  an  option  ’, 
’or  asked  a  Yes  or  No  question,’); 

WRITELNC’  the  ’ , CHR ( 1 5 ) , ’ RETURN ’ , CHF (1 4 ) , 

’  key  need  not  be  pressed CHR ( 1 3 )> ; 

WRITELN<CHR ( 15) , ’NOTE: ’ ,CHR ( 14) , ’  V' u  will  be  asked', 
’  i-f  you  have  a  printer  on-line.  It  you’); 

WRITELNI’  say  YES  and  there  is  not,  the  ’, 

’prograiTi  will  run  slower’’); 

END;  (*  End  ot  PAGE  2  ♦) 


<*  Mam  bod,  ot  OVERVIEW  *) 


BEGIN 

WRITElN (CHR ( 12) , ’  ’ : 1&,CHR(15) , ’  PASCAL  STATISTICAL  ’, 
’PROCEDURES  PACKAGE  ’,CHR(14)); 


PAGEl ; 

GOTOXY (22,22) ; 

WRITE (’Press  any  key  to  continue  ’); 
GETOPTION(QFT) ; 

ERASE (5,18); 

PAGE2; 

G0T0XY<22,22) ; 

WRITE(’Press  any  key  to  continue  ’); 
GETOPTION(OPT) ; 

END;  <*  End  o-f  OVERVIEW  *) 


< 


) 


PROCEDURE  GETSPEC; 

BEGIN 

WRITELN(CHR (12) , ’  ' : 16, CHR ( 1 5) , ’  PASCAL  STATISTICAL  ’, 
’PROCEDURES  PACKAGE  ’,CHR(14)); 

GOTOXY (0, 10) ; 

WRITE(’Do  you  have  a  printer’’  ’,CHR(15),’  (Y/N)’, 

CHR ( 14) ) » 

GETOPTION (OPT) 1 

while  (OPTO’Y’)  AND  (OPTO’y’)  AND 
(OPTO’N’)  AND  (OPTO’n’)  DO 
GETOPTION (OPT) 5 

IF  (0PT«’Y’)  OR  (0PT«’y’)  THEN 
PRINTER: -TRUE 

ELSE 

PR INTER: -FALSE; 

END;  <*  End  ot  GET  printer  SPECi t i cat i on  •) 


(a 

(* 

<* 


BEGIN 


Main  body  o-f  START  UP 


*) 
*) 
* ) 


(*»S**) 


UNIT  DATft_MDD; 

INTERFACE 

USES  TRANSCEND,  MAIN_UNIT,  MU_A,  MU_B,  MU_C,  MU_D,  MU_E; 

PROCEDURE  DATAMQDULE (VAR  DATA: RAWDATA: VAR  SPECS  1 : HEADER  I : 

VAR  SFECS2:HEADER2!PRINTER:B00:_EAN)  ; 

implementation 


<*  Main  body  oT  DATA_MDDule  *) 

(•••«••••••«*••••«•*«••***•«••«•«•••»•••••••••••*«•»«*•*•*••»•••*•*«) 

PROCEDURE  DATAMODULE; 

<«  ♦) 

(*  This  procedure  handles  data  input,  modi t i cat i on ,  and  *) 

(*  data  storage  to  disks  previously  formatted  by  •) 

<*  the  PASCAL  operating  system.  •) 

(•  a ) 

(a  This  procedure  needs  as  input:  a) 

(a  a) 

<a  DATA  -  Array  o-f  and  •for  data  storage  a) 

<a  BPECSl  -  Array  of  field  or  variable  names  a) 

(a  SPECS2  -  Array  of  field  widths  t(  file  specs  a) 

<a  PRINTER  -  Indicator  of  printer  presence  a) 

(a  a) 

<*  This  procedure  provides  as  output  the  above  arrays  a) 

<*  stored  on  disk  or  printed  to  screen  and  printer.  a) 

(a  a) 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

VAR 

OPT:  <a  Menu  option  a) 

CHAR! 

DONE:  (a  Completion  indicator  a) 

BOOLEAN; 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

(a  Internal  Procedure  a> 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 


PROCEDURE  GOTOPMENU; 

BEGIN 

WRITELN(CHR(12),'  ' ; 2B, CHR ( 15) , ’  DATAMODULE  ',CHR(14)); 
B0T0XY(0,5) ; 

WRITELN ( ’ Sel ect  desired  option:’); 

WRITELN<’  1  -  Create  a  new  data  file’); 

WRITELN (’  2  -  Gave  a  file  to  disk’); 

WRITELN(’  3  -  Load  a  file  from  disk’); 

WRITELN!’  4  -  Modify  data  in  file’); 

WRITELN ('  S  -  Echo-check  data  in  file’); 

WRITELN!’  6  -  Exit  DATA  MODULE’); 


BETOPTION(OPT) ; 


(*•5**) 


UNIT  CANC0R_M0D; 

INTERFACE 

UBE5  TRANSCEND,  MA1N_UN1T,  MU_E,  MU_F,  MU_G,  MU_H,  MU_J ,  MU_K; 

PROCEDURE  CANCORtUAR  DATA: RAWDATA; VAR  SPECS  1 : HEADER 1 ; 

VAR  BPECS2:HEADER2;PRINTER:BD0LEAN)  : 

implementation 


(*  Main  body  o-f  CANCOP_MODu  1  e  *) 


PROCEDURE  CANCOR; 


*  *) 


This  procedure  allows  -for  the  division  o+  the  DATA  •) 

array  into  two  sets  of  variables.  It  then  ♦) 

derives  a  linear  combination  -from  each  set  •) 

such  that  the  correlation  between  the  two  •) 

linear  combinations  is  maximited.  •) 

a ) 

This  procedure  needs  as  input:  a) 

a) 

DATA  -  Array  of  data  to  be  analyzed  a) 

6PECS1  -  Array  0+  ^ield  or  variable  names  a) 

BPECS2  -  Array  of  •field  widths  fc  file  specs  a) 

PRINTER  -  Indicator  of  printer  presence  a) 

a) 

This  procedure  produces  and  outputs  the  canonical  a) 

variates  and  the  correlations  between  them.  a) 

a) 

NOTE:  The  rawdata  is  standardized  but  not  a) 

automatically  saved  to  disk.  a) 


a  a> 


VAR 


I. 

(a 

p, 

(a 

K, 

(a 

NUMREC, 

<a 

midth: 

<a 

INTEGER; 

opt: 

<a 

char; 

BROUP: 

la 

HEADER2; 

XBAR, 

(a 

SDEV, 

(a 

EIGVAL, 

(a 

CANCORS, 

(a 

WILKBL, 

la 

CHISQR: 

la 

vector; 

COPRMAT, 

la 

Iteration  counter  a) 

Number  of  criterion  variables  a) 
Number  of  predictor  variables  a) 
Number  of  records  in  DATA  a) 

Number  of  fields  in  DATA  a) 

Menu  option  a) 

Variable  type  designations  a) 

Variable  means  •) 

Variable  standard  deviations  •) 
Calculated  eigenvalues  a) 

Canonical  correlations  •) 

Milk’s  Lambda  statistics  •) 

CHI  Square  statistics  a) 

Sample  Correlation  Matrix  •> 
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EIGVEC, 

(• 

ft. 

(• 

BETA; 

(* 

matrix; 

FEAS, 

(• 

DONE: 

(• 

Ei gen vectors/Y  Canonical  wts  *) 
Matrix  to  get  eigenvalues  O'f  *) 
Scaled  X  Canonical  weights  •) 

Feasible  matrix  inversion  ♦) 
Completion  indicator  *) 


boolean; 


<♦  Internal  Procedures  •) 

(a******************************************************************) 


PROCEDURE  GETVARSNETATS; 

BEGIN 

(**P  MU_F  *)  (•  Retain  UNIT  in  memory  *) 

ASSIGNVARIABLES<SFECS1,SPECS2, GROUP, l.FEAS) ; 

IF  (FEAS)  THEN 
BEGIN 

Pi-GROuPC-n; 

k::=group[03*. 

ERASE (5,18); 

IF  (PRINTER)  THEN 
BEGIN 

WRITE (PTR.CHR (12) , CHR (IB) , CHR ( 14) , 

'  7, ’CANONICAL  CORRELATION’, 

CHR (20) , CHR (15) ) ; 

FOR  l:=l  TO  3  DO 

WRITELN(PTR) ; 

end; 

B0T0XY(0,22)  i 

WR I TELN(’ Calculating  MEANS  i  STANDARD  ', 

'DEVIATIONS.  .  .Please  stand  by  *); 

CALCULATE ( XBAR, SDEV, DATA, SPECS 1 , GROUP, NUMREC , 
WIDTH, PRINTER) ( 

ERASE(22,1)I 
G0T0XV(O,2O) ; 

WRITELN ( ’ Sel ect  desired  option:’); 

WRITELN(’  1  -  Proceed  with  ’, 

’standardization’ ) ; 

WRITELN(’  2  -  Exit  CANCOR  routine’); 

BETOPTION(OPT) ; 

WHILE  (OPTO’l’)  AND  (OPTO’ 2’)  DO 
BETOPTION(OPT)  ; 

ERASE (20,3); 

IF  (OPT-’ 2’)  then 
done: -TRUE; 

END 

ELSE 

DONE: -TRUE; 


END;  (a  End  of  GET  VARiableS  aNd  GTATisticS  •> 


PROCEDURE  STANDNGETCORRMAT; 

BEGIN 

<**R  MU_G  *)  (*  Retain  UNIT  in  memory  *) 

ERASE  <5,18); 

GOTOXY (0,20)  ; 

WR I TELN ( ’ St andar di z 1 ng  designated  variablee.  • 

‘Please  stand  by  ’>; 

STANDARDIZE (DATA, XBAR, SDEV, GROUP , NUMREC , W I DTH , ’ 2’  )  ; 

GOTOXY (0, 22) ; 

WP I TELN ( CHR (7) , ‘ Generat  1  ng  Correlation  Matrix.  . 

‘Please  stand  by  ‘): 

GENMATRIX (DATA, CORRMAT, SPECS 1  ,  GROUP ,  NUMREC , 
width, PRINTER) ; 

GOTOXY (0,20) ; 

WR I TELN ( ’ Sel ect  desired  option:‘); 

WRITELN(‘  J  -  Proceed  witn  statistics  ’, 

‘ cal cul at  1  on ’  ) ; 

WRITELNC  2  -  Exit  CANCOR  routine‘); 

GETOPTION(OPT) ; 

WHILE  (OPTO‘1')  AND  <0PT<>‘2')  DO 
GETOFTION(OPT)  i 

IF  <0PT=‘2‘)  THEN 
DONE:=TRUE} 

END;  (a  End  o-f  STANDardize  aNd  GET  CORRelation  MATrix  •) 


) 


PROCEDURE  CALCULATESTATS; 

BEGIN 

(•fR  MU_H  ♦)  (*  Retain  UNIT  in  memory  *) 

ERASE (2,21 ) ; 

GOTOXY (0, 22) I 

WRITELN  ( ‘  Cal  CLiI  at  i  ng  Eigenvalues.  . 

‘Please  stand  by  ‘>( 

PREPTOE I G ( CORRMAT ,P,K,A,FEAS); 

IF  NOT(FEAS)  THEN  <*  Mul t i -col  1 i near i ty  trap  •) 

BEGIN 

GOTOXY (1,22); 

MRITELN<CHR(15> , 'WARNING: ‘ ,CHR( 14) , ‘  Data  is  ‘, 

' multi  col  1  inear.  CANCOR  can  not  proceed’); 
WRITEC  ‘:n, ‘Press  any  key  to  exit  ‘)I 
G0T0XY(0,22)  ; 

BETOPTION(OPT) ; 

DONE: -TRUE; 

END; 


IF  NOT (DONE)  THEN 


(a  Continue  calculating  stats  a) 


BEGIN 

EIGEN(P,A,E1GVEC,EIGVAL)  ; 

ERASE  <22,  1 )  ; 

BOTOX Y (0,20) ; 

WR I TELN (CHR ( 7) , ’ Cal cul at  1 ng  Canonical 

'  Corn  el  at  1  one,  Wi  1 1- ’  ’  a  Lambda,  and  ’, 
’CHI  Square.  .  .’,CHR(13)); 

GETCANCORBT ATS (El GVAL , CANCDRE , W I LXSL , CH I SOR , 
NUMREC, P, K, PRINTER) ; 


GOTOXY (0, 20) ; 

WR 1 TElN ( ’ Sel ect  desired  option:’); 

WR1TELN<’  1  -  Proceed  with  Canonical  ’, 

’Variable  calculation’); 

WRITELNC  2  -  Exit  CANCDR  routine  ’); 

BET0PTI0N<0PT) ; 

WHILE  (OPTO’l’)  AND  (OFTO’2’)  DO 
GETOPTION(OPT) ; 

IF  <0PT=’2’)  THEN 
DONE ; =TRUE ; 

END; 

END;  <*  End  o-f  CALCULATE  BTATisticS  *) 


PROCEDURE  GETSTRUCTCORR; 


BEGIN 

ERASE (5, IB) ; 

GOTOXY (0,22) ; 

WRITE <’ Cal cul at  1 ng  Canonical  Variate  Coet 1 1 ci ent s ’ , 
’.  .  .Please  stand  by  ’>; 

GETCVCS  < CANCORS, E I GVEC, BETA, CORRMAT , SPECS 1 , 

GROUP, PR  INTER) ; 

60T0XY (0,22) ; 

WRITE <’ Cal cul at i ng  Canonical  Variate  Scores.  . 
’Please  stand  by  ’>• 


GETCVSS  < DAT A , GROUP , E I GVEC, BETA, NUMREC , 

WIDTH, PRINTER) I 

G0T0XY(0,22) ; 

WRITECCalculatlng  Structure  Correl  at  i  ons.  . 
’Please  stand  by  ’>; 

BTRUCTURECORR  < E I GVEC , BET A , CORRMAT , E I GVAL , SPECS 1 , 
GROUP, WIDTH, PRINTER)  ; 

!  <#  End  o-f  GET  BTRUCTure  CORRelations  •) 


(• 

<a 

<# 


END 


Main  body  o*  CANCOR 


*) 

*) 

*) 


BEGIN 

NUMREC: =SPEC52[ - 1  I ;  (♦  Initialize  parameters  *) 

width: =5PECsr[oi : 

DONE: =FALSE; 

FEAS: =true; 

WRITELN(CHR ( 12) , •  ' : 20, CHR ( 1 5) , ’  CANONICAL  CORRELATION 

'ROUTINE  ’,CHR(14)); 

GOTOXY (0, 20) ; 

WRl TELN ( • Sel ect  desired  option:’); 

WPITElN(’  1  -  Proceed  with  variable  selection’); 

WRITELN(’  2  -  Exit  CANCOR  routine’); 

GET0PTI0N<0PT) ; 

while  (OPTO’l’l  AND  (0FT<>’2’)  DO 
GETOPTION (OPT) ; 

IF  <OPT=’2’)  THEN 
DONE: =TRUE; 

ERASE (20,3); 

IF  NOT (DONE)  THEN  <*  Input  t<  Calculate  statistics  ♦) 

GETVARSNSTATS; 

IF  NOT (DONE)  THEN  <*  Btandardiie  *.  Get  Corr  Mat  •) 

standngetcorrmat ; 

IF  not (DONE)  THEN  <*  Calculate  statistics  *) 

CALCULATESTATS; 

IF  NOT(DONE)  THEN  <*  Get  Structure  Correlations  *) 

getstructcorr; 

end;  (*  End  oF  CANCOR  *) 


(*  Ini  t i  al  i  z  :tion  part  o-f  UNIT  *) 


UN]T  FACTOR_MDD; 


INTERFACE 

USES  TRANSCEND,  APPLESTUFF,  MA1N_UMT,  MU_E,  MU_F,  MU_G, 

MU_H,  MU_I,  MU_K; 

PROCEDURE  factor (VAR  DATA: RAWDATA; VAR  SPECS  1  : HEADER  1 : 

VAR  BPECS2 : HEADER!; PR INTERzBODuEAN;  ; 

IHPLEHENTAT 1  ON 


(♦  Main  part  o-f  FACTDR_MDDu;  e  *) 

PROCEDURE  FACTOR; 

<*  *) 

(*  This  procedure  looks  For  an  underlying  pattern  oF  *) 

<*  relationships  between  members  o4  a  designated  *) 

(*  set  cF  variables  so  that  a  possible  reduction  •) 

(•  to  a  smaller  set  oF  Factors  or  components  can  *) 

(•  be  done.  «> 

(*  *) 

<•  This  procedure  needs  as  input:  *) 

<*  DATA  -  Array  oF  data  to  be  analyzed  •) 

(♦  SPECSl  -  Array  oF  Field  or  variable  names  *) 

(♦  SPECS!  -  Array  oF  Field  widths  ti  File  specs  •) 

(•  PRINTER  -  Indicator  oF  printer  presence  *) 

(*  ♦) 

<*  This  procedure  produces  and  output  the  Factor  *) 

(•  Loadings,  Communal i t i es,  CoeF F i c i ent s ,  and  •> 

<*  Bccres  For  a  given  set  oF  data.  *) 

<•  • ) 


VAR 


I, 

<* 

N, 

<* 

NS, 

<* 

NUMREC, 

(♦ 

width: 

INTEGER; 

<• 

opt: 

CHAR; 

(• 

GROUP: 

HEADER!; 

<* 

FEAS, 

(* 

DONE: 

boolean; 

<* 

XBAR, 

(* 

8DEV, 

<* 

eigval: 

(* 

(• 

<* 

(• 


Iteration  counter  *) 
Number  oF  Factors  *) 
Number  oF  SigniFicant  Factors  *) 
Number  oF  data  records  *) 
Number  oF  record  Fields  *) 

Menu  option  *) 

IdentiFies  designated  set  «) 

Feasibility  indicator  *) 
Completion  indicator  •) 

Array  oF  Field  means  *) 
Array  oF  Field  Standard  Dev.  •) 
Array  oF  Eigenvalues  •) 

Correlation  matriK  •) 
Array  oF  Eigenvectors  •) 
Array  oF  Factor  CoeFFicients  *) 


CORRMAT , 

EIGVEC, 

FACTCOEF 


VECTOR? 


MATRIX ; 


(*  Internal  Procedures  *) 


PROCEDURE  inputncalcstats; 

BEGIN 

(••R  MU_F  *)  (*  Retain  UNIT  in  memory  *) 

ASSIGNVARIABLEB (SPECS 1 , SPECS2, GROUP, 2, PEAS) ; 

IF  (FEAS)  THEN 
BEGIN 

IF  (PRINTER)  THEN 
BEGIN 

WRITE (PTR, CHR ( 12) , CHR (IB), CHR ( 14) , ’  ’ : 10, 

•FACTOR  ANALYSIS’  , CHR (20) , CHR I  15)  ) ; 
FOR  l:=l  TO  3  DO 
WRITELN(PTR) i 

END; 

n:=groupco3; 

ERASE (5, 18) ; 

G0T0XY(0,22) ; 

WR 1  TE  ( ’  Cal  cul  at  i  ng  Means  St  Standard  Deviations’, 
•.  .  .Please  stand  by  ’)> 

CALCULATE ( XBAR, SDEV, DATA, SPECS 1 , GROUP , NUMREC , 
WIDTH,  PRINTER)  ,* 

G0T0XY(0,20)  ; 

WR I TELN(’ Select  desired  option:’); 

WRITELNC  1  -  Proceed  with  ’, 

’Standardization’ ) ; 

WRITELN(’  2  -  Enit  FACTOR  routine’,’  ’:30); 

GETOPTION(OPT) ; 

WHILE  (OPTO’l’)  AND  (OPTO’2’)  DO 
GETOPTION(OPT) ; 

IF  (0PT«=’2’)  THEN 
DONE: -TRUE; 

END 

ELSE 

done:=true; 

END;  (a  End  o*  INPUT  variables  t<  CALCulate  STATisticS  *) 


< 


) 


PROCEDURE  STANDNGETCORRMAT; 

BEGIN 

(•♦R  MU_B  •)  (*  Retain  UNIT  in  memory  *) 

ERASE (S, 18) ; 

SOTOXY (0,20) ; 

WRITE (’ Btandardi z ing  data.  .  .Please  stand  by  ’>1 
BTANDARDIZE(DATA, XBAR, SDEV, GROUP, NUMREC, WIDTH, ’2’ ) I 
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G0T0XY(0,22) J 

MRITE (CHR (7) , ’ S«n»rati ng  Correlation  Hatrix.  . 

’Please  stand  by 

GR0UPC-13:-TRUNC(N/2.0) ;  (•  Partitions  * 

GROUP  C  0 : : »N-GR0UP  C - 1 3 ; 

GENMATR 1 X  <  DAT A , CORRMAT , SPECS 1 , GROUP , NUMREC , 

WIDTH, PRINTER) ; 

GR0UPC03:=N; 

S0T0XY(0,20) ; 

WRITELN (’ Select  desired  option:’); 

MRITELN<’  1  -  Proceed  with  FACTOR  calculation’); 

MRITELNC  2  -  Exit  FACTOR  routine’); 

GETOPTIONCOPT) ; 

WHILE  (OPTO’l’)  AND  <0PT<>’2’)  DO 
GETOPTION(OPT) ; 

IF  (OPT-’ 2’)  THEN 
DONE : -TRUE ; 

END;  <*  End  o-f  STANDardize  b  GET  CORRelation  MATrix  *) 


PROCEDURE  GETSTATSNSCORES; 

BEGIN 

ERASE <2, 21 ) ; 

GOTOXY(0,22); 

WRITE (’ Cal cul ating  Eigenvalues.  . 

’Please  stand  by  ’ > ; 

EIGEN<N,CORRMAT,EIGVEC,EIBVAL) ; 

ERASE(22,1)| 

8ELECTFACT0RS  <  NS , NUMREC , E I GVAL , GROUP , PR I NTER ) ; 
B0T0XY(0,22) I 

WRITE  (’ Cal  cul  atin(-  Factor  Loadings.  . 

’Please  stand  by  ’>( 

F ACTORMAT  <  E I GVAL , E I GVEC , FACTCOEF , SPECS 1 , GROUP , 
WIDTH, PRINTER)  ’, 

GOTOXY (0,22) I 

WRITE (’ Cal cul ati ng  Factor  Scores.  . 

’Please  stand  by  ’>; 

BETFACTBCORES (DATA, FACTCOEF, GROUP, NUMREC , 
WIDTH, PRINTER) ; 

END!  (•  End  o4  GET  BTATistics  b  factor  BCURES  •> 


aaaaaaaaaaaaaaaaaaaeeaaaasesaaaaaaaaaaaaasaaaaaaaaaaaaaaaaaaaaa**** 
•  Main  body  of  FACTOR  routine  * 
eaaaaaaaaaaaaaaaaaaeaaaaaaaaaasaaaaaaaaaaaaaesassaaaaaaa-saae******* 


lp^D-fil41  049 

1  UNCLRSSIFIEI 

PflSCRL  STRTISTICRL  PROCEDURES  PRCKRGE  (PSPPXU)  RIR 
FORCE  INST  OF  TECH  HRIGHT-PRTTERSON  RFB  OH  SCHOOL  OF 
ENGINEERING  D  P  KUNREL  DEC  83  flFIT/GS0/0S/83D-4 

F/G  9/2 

2/ 

NL 

■■■ 

BEGIN 

NUMREC: «SPECS2C-1 3  » 

WIDTH: -SPECS2C0]; 

DONE: -FALSE t 
PEAS ‘.-TRUE) 

WRITE!  4(CHR<I2>,’  • :2B,CHR<15) , ’  FACTOR  ANALYSIS  ROUTINE 
CHR(14>)t 
0OT")iY(O,2O)| 

WRITELNC Select  desired  option:')) 

WRITELNC  1  -  Proceed  Nith  veriable  selection')) 

WRITELN)'  2  -  Exit  FACTOR  routine')) 

GETOPTION<OPT) ) 

WHILE  (OPTO'l')  AND  <0PT<>'2')  DO 
QETOPTION<OPT); 

IF  <0PT-'2')  THEN 
DONE: -TRUE) 

ERASE <20, 3)1 

IF  NOT (DONE)  THEN 

XNPUTNCALCSTATS) 

IF  NOT (DONE)  THEN 

6TANDNGETC0RRMAT ) 

IF  NOT (DONE)  THEN 
6ETSTATSNSC0RES) 

END)  (•  End  04  FACTOR  routine  •) 

<#'• 

<• 

<*< 


END 


Initialization  part  of  UNIT 


*) 

a) 

*) 


UNIT  MAIN.UNIT;  INTRINSIC  CODE  27  DATA  28; 


INTERFACE 


CONST 

HAXREC  -  200; 
MAXSIZE  =  10; 


<*  Maximum  number  records  per  file  *) 
<*  Maximum  number  O'f  ■fields  per  record  *) 


VECTOR  «  ARRAY! 1 . .MAXSI7E3  OF  REAL; 

MATRIX  »  ARRAY! 1 . ,MAXSI2E3  OF  VECTOR; 

HEADERl  *  ARRAY!0. .MAXSI2E3  OF  STRING! 153; 
HEADER2  «  ARRAY !- 1 .. MAXSI 2E3  OF  INTEGER; 
RAWDATA  ■  ARRAY! 1 . .MAXREC, 1 . .MAXSI2E3  OF  REAL; 


PRINTER: 

DATAFILE, 

ptr: 

SPECS 1 : 

BPECS2: 

DATA, 

SCORES: 


boolean; 


HEADERl; 

HEADER2; 


ramdata; 


<•  Flag  set  indicates  printer  presence  •) 

<•  Used  ■for  data  transfer  to/from  disk  •) 
(■*  File  to  hold  text  to  be  printed  •) 

(•  Array  O'f  field  and  variable  names  «) 

(•  Array  of  field  widths  ti  file  specs  •) 

<•  Array  of  data  used  by  all  routines  •> 

<♦  Array  of  FACTOR  or  CANCOR  scores  ♦) 


PROCEDURE  SETDPTIONfVAR  OPTrCHAR); 
PROCEDURE  erase; ROW, LINES: INTEGER) ; 


IMPLEMENTATION 


Main  body  of  MAIN_UNIT 


PROCEDURE  GETOPTION; 


This  procedure  rings  •  bell  to  alert  the  user  to 
a  required  input,  then  accepts  1  character. 

It  Is  used  after  menu  displays  and  as  means 
of  delaying  operation  until  signaled  by  user. 


BEGIN 

WRITE(CHR(7) ) I 
READ ( KEYBOARD ,  OPT ) t 
END;  <•  End  of  GETOPTION  •) 


(•  Ring  bell  to  alert  user  a) 
<a  Accept  a  single  character  •) 


PROCEDURE  ERASE; 


<*»S+*) 


UNIT  MU_AJ  INTRINSIC  CODE  111 

INTERFACE 

USES  MAIN_UNIT; 


PROCEDURE  MAKEFILE (VAR  DATA: RAWDAT A; VAR  SPECSl : HEADERl ; 
VAR  SPECS2:HEADER2) I 


IMPLEMENTATION 


<♦  Main  body  of  MU  A  *) 


PROCEDURE  makefile; 


«  •> 


This  proodur*  accepts  as  input  tbs  contents  of  a  •> 

data  arravt  speci 'f  i cati  ons  as  to  the  size  and  •> 

Midtb  o'f  the  data  'fields  and  names  for  each  field.  •> 

*> 

This  procedure  returns  as  output;  •) 

«) 

DATA  -  Array  of  raw  data  as  input  by  user  •) 

SPECSl  -  Array  of  field  or  variable  names  *> 

SPECS2  -  Array  of  field  widths  •) 


•  •) 


VAR 


I, 

(a 

Iteration  counter 

a) 

COLS, 

(a 

Number  of  columns 

a> 

FIELD, 

(a 

Field  identifier 

a) 

INDEX, 

(a 

Index  into  arrays 

a> 

NUMREC, 

(a 

Number  of  records 

a) 

ROW, 

(a 

Row  on  screen 

a> 

width: 

(a 

Number  of  fields 

a> 

INTEGER; 

VALUE: 

(a 

User  inputed  data 

a) 

REAL! 

DONE: 

(a 

Exit  indicator 

a> 

boolean; 

OPT; 

(a 

Menu  option 

a) 

char; 

<esaess*s**sssse*sssssssses*ss*sssss»sss*ssssssss*sssssssssssss«s*««) 

<*  Internal  Procedures  *> 

(eseesesssesssssssssssssssssesssssesssssssasssssssssssssssssssssessa) 


PROCEDURE  PAGE II 
BEGIN 

HRITELNC Before  entering  the  data,  modify  it  as 
'follows:  ’,CHR<13)>I 

NRITELNC  i  -  All  entries  must  be  numeric. 

'Bee  user"e  manual  for  help’ll 
HRITELNC  on  converting  letters  to  numbers.’)! 
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WRITELN; 

WRITELNC  2  -  Upper  limit  o-f  ' ,  MAXSI ZE,  ’  'fields 

•or  Venables  per  record.’); 

WRITELN; 

WRITELN;'  3  -  Upper  limit  o-f  ’,MAXREC,’  records 

•per  data  fi le. ’ > ; 

WRITELN; 

WRITELN<^  4  -  Upper  limit  of  BO  characters  per 

•record.  This  includes  all’); 

WRITELNC  decimal  points  and  spaces  between  ’, 

’■fields.  ’ ) ; 

WRITELN: 

WRITELN;’  5  -  The  first  field  of  any  record  can  ’, 

’not  be  9999.  This  value’); 

WRITEln;’  is  used  to  signify  data  entry  ’, 

’completion. ’ > ; 

END;  (*  End  of  PAGE  1  *’ 


< 


) 


PROCEDURE  PAGE2; 

BEGIN 

WRITELN (’ Order  of  entry  is  as  f ol 1 ows: ’ , CHR ( 13) , CMR ( 13) ) ; 

WRITELN;’  First  -  The  number  of  fields  or  variables 
•is  requested. • ,CHR ; 13) ) ; 

WRITELN ;•  Next  The  name  and  width  of  each  field  is 
•requested.  Remember  to’); 

WRITELN;*  leave  room  for  the  largest  value  in 

•each  field.  Also,  the’)f 

WRITELN;*  field  name  should  be  less  than  or  ’, 

'equal  to  the  width,  or  it')f 

WRITELN;’  will  be  truncated  to  fit. ’ ,CHR;13) ) f 

WRITELN; ’Finally  -  Each  record  is  entered,  one  field  at’, 
’  a  time.  After  the  last’); 

WRITELN;*  field  is  entered,  you  will  be  asked  ’, 

•if  any  changes  need  to  be’); 

WRITELN;’  made.  Enter  9999  in  the  first  field’, 

’  to  signify  completion.’); 

END;  («  End  of  PAGE  2  •) 


) 


PROCEDURE  SHOW INSTRUCT IONS; 

BEGIN 

WRITELN <CHR< 12),’  ’ : 23,CHR ( 15) , ’  DATA  ENTRY  ’, 
•INSTRUCTIONS  ’,CHR(14)); 

60T0XY(0,5) ; 

PAGEl; 

eOTOXY(22,22) 1 

WRITEf’Press  any  key  to  continue 

betoption;opt) ; 

ERASE ;S, IS) I 
e0T0XY<0,S) I 

PA0E21 
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) 


B0T0XY(22,22) : 

WRITECPrasft  any  k»y  to  continu* 
BETOPTIONCOPT) ; 

ENDt  (a  End  O'f  SHOW  INSTRUCTIONS  •) 


<**1  PSPP:  BfiTHERDATA  ♦)  <•  Include  ■♦lie  in  compilation  •) 


PROCEDURE  DISPLAYMENU; 

BEGIN 

MRITELN(CHR(12),’  ' : 25, CHR ( 15) , ’  DATA  ENTRY  PROCEDURE 
CHR<14) ) ; 

B0T0XV<0,5) ; 

WRITELN ( ’ Sel ect  deeired  option:’)! 

WRITELN<’  1  -  Display  instructions’); 

WRITELN(’  2  -  Enter  raw  data’)! 

WRITELNC  3  -  Exit  DATA  ENTRY  procedure’); 

SETOPTION<OPT> 1 

WHILE  <0PT<’1’)  OR  (0PT>’3’)  DO 
BETOPTION(OPT) ! 

CASE  (OPT)  OF 

’  1 '  ;  SHOWINSTRUCTIONS,’ 

•2’ ibatherdata; 

'3’ : done: -true; 
end; 

end;  (•  End  O'f  DISPLAY  MENU  •> 


(•  Main  body  o*  MAKEFILE  •) 


BEBIN 

DONE: -FALSE; 

WHILE  NOT (DONE)  DO 
DISPLAYMENU; 

END;  <a  End  O'f  MAKE  FILE  •) 


PROCEDURE  GATHERDATA 


(*  «) 

(•  This  procedure  is  the  mam  working  section  used  •) 

<*  by  MAKEFILE  to  structure  and  ♦ill  the  data  *) 

(•  and  sped ♦ ication  arrays.  •) 

<•  •) 

. . . 

. . . 

<*  Procedures  internal  to  GATHERDATA  *) 

. . . 


PROCEDURE  DISPLAYSPECS5 
BEGIN 

B0T0XV<0,7) ; 

FOR  l:«l  TO  WIDTH  DO 

WRITELNd  :7,SPECS2CI  3: 12,  ’  * :  7,  BPECSl  C  1 3 ,  CHR  (29)  )  ; 
END;  <•  End  O'f  DISPLAY  SPECS  *) 


PROCEDURE  HANDLE INVALID; 

BEGIN 

(#•!-*) 

WRITE (CHR<8) , ’  •;20)l 
B0T0XY(1,20) 1 

WRITE(CHR(15) , ’WARNING: * ,CHR(14) Value  must 

’be  a  number.  Press  any  key  to  continue  ’); 
B0T0XY(0,20) I 
GETOPTION(OPT)  { 

ERASE (20,1); 

G0T0XY(33,R0W) 1 
RESET (INPUT) ; 

READ (VALUE) 1 
(•SI-i-*) 

END;  <•  End  o-f  HANDLE  INVALID  entry  •) 


PROCEDURE  ENTERVALUE; 

VAR  NAME:  STRING;  (•  Field  name  to  enter  a> 

BEGIN 

<*«I-e) 

R0W:>FIELD-^6; 

BOTOX V(0, ROW) ; 

NAME : wGPECS 1 C  F I ELD  3 ; 

IF  (LENGTH (NAME) >15)  THEN  (•  Truncate  names  to  4it  «) 

NAME: -COPY (NAME, 1, 15) ; 

HRITELN (FIELD: 4, name: 16, 6PECB2CFIELD3 : 7) ; 

G0T0XY(33,R0W) ; 

RESET ( INPUT ) ; 

READ (VALUE) ; 

WHILE  <I0RE8ULT-14)  DO 
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HANDLEINVALIDi 
DAT A  C  NUMREC , F I ELD  3 : = VALUE ; 

END;  (•  End  O'*  ENTER  VALUE  •) 

. . . 

PROCEDURE  CHANGE VALUE; 

VAR  FIELD:  INTEGER;  (*  Field  to  be  changed  *) 

BEGIN 

<*•!-*) 

GOTOX> (0, 19) ; 

WRl TELN (’ Enter  Field  to  change:’); 

MRITELNC  <0  =  Skip  change)’); 

RESET (INPUT); 

READ (FIELD) ; 

WHILE  <I0RESULT=14)  OR  <FIELD<0)  OR  (FIELD>W1DTH)  DO 
BEGIN 

S0T0XY(0,22) ; 

WRITE (CHR (7) , ’ Bad  Field  number.  Press  any  ’, 

’key  to  try  again  ’); 

BETOPTION(OPT) ; 

ERASE (21, 2) ; 

S0T0XY(0,21) ; 

RESET (INPUT) I 
READ (FIELD) ; 

END;  <s  End  oF  Invalid  Index  •> 

ERASE (19, 4) ; 

IF  (FIELDOO)  THEN 
BEGIN 

R0W:-FIELD-»6; 

G0T0XY(56,R0W) ; 

WRITE (CHR ( 15), ’<•  Enter  new 
G0T0XY(33,R0W) ; 

RESET (INPUT); 

READ (VALUE) ; 

WHILE  (lORESULT-M)  DO 
HANDLE invalid; 

DAT  A 1 1 NDE  X ,  F I  ELD  3 : -VAL  UE ; 

G0T0XY(56,R0W) ; 

WR1TELN(CHR(29))| 

END; 

(••I-»«) 

END;  <•  End  OF  CHANGE  VALUE  •) 

(•••»••••••**#•«••••••••••••••••••••••••«••••••••••«••••••*•••••••••) 

PROCEDURE  GETFLDWIDTH; 

BEGIN 
(•♦I -a) 

B0T0XY(60,5> ;  (•  Display  column  status  •> 

MR 1 TE ( CHR ( 1 5 ) , COLS : 3, CHR ( 1 4 ) > ; 

B0T0XY(76,S) I 

MRITE(CHR(15) , (BO-COLS) : 3, CHR ( 14) ) ; 


(•  Hake  change  •) 


value: ’ ,CHR(14)  )  ; 


GOTOXYdB.ROW)  ! 

RESET (INPUT) ; 

READ (SPECS2C INDEX ] ) ; 

WHILE  <10RESULT-14)  OR  (SPECS2t INDEX 3<B)  DR 

<BPECS2t  INDEX3MS)  OR  (C0LS+SPECS2C  INDEX  3  >80)  DO 

BEGIN 

GOTOXV  dfc.ROW) ; 

WRlTELN(CriR (29) ) ; 

GOTOXY  (56,  ROW)  ;  (•  Error  tieesagee  *) 

IF  <SPECS2[ INDEX3<B)  THEN 

WRITE  (CHRdS), 'Mu&t  be  at  lea&t  B’.CHRdA)); 

IF  (SPECS2t INDEX3>15)  OR  (C0LS+SPECS2C INDEX3 >B0)  THEN 
BEGIN 

IF  (SPECS2CINDEX3>15)  AND 

<CDLS->BPECS2t  INDEX3>B0)  THEN 

BEGIN 

IF  <80-CDLS<15)  THEN 

WRITE (CHR ( 15) , 'Must  be  no  more 
’than  BO-COLS, CHR (14) ) 

ELSE 

WRlTE(CHRd5>  , ’Must  be  no  more 
'than  15’,CHRd4)) 

END 

ELSE 

BEGIN 

IF  <BPECB2tlNDEX3>15)  THEN 

WRITE(CHR(15> , ’Must  be  no  more  ’, 
'than  15’,CHRd4)) 

ELSE 

WRITE<CHRd5> , ’Must  be  no  more  ’, 
'than  ’, BO-COLS, CHR (14) ) 

END 

END;  <*  End  of  Error  Messages  •) 

G0T0XYd6,R0W>  ; 

RESET (INPUT); 

READ(SPECS2IINDEX3) ? 

END;  <a  End  of  Bad  Width  •> 

COLS :  >C0LS-»SPECG2  C 1 NDEX  3 ,' 

60T0XY (60,5) ;  (•  Display  column  status  •> 

WRlTE(CHRd5)  ,COLS:3,CHRd4))5 
60T0XY(76,5) ; 

WRITE (CHR (15), (BO-COLS) : 3, CHR (14) > 1 
<#«!♦*) 

END}  (•  End  of  GET  FIELD  WIDTH  •) 


(•••••aeeeeeaeaaaeeaaeeeeaaaeeeeeaeeeaaasaaaaeeaeeaeaeaaaeaese******) 

PROCEDURE  GETFLDNAME; 

BEGIN 

<*S1-*) 

e0T0XY(26,R0W) I 
WRITE (CHR (29) ) | 

RESET (INPUT) | 
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RE ADLN ( SPECS  1 [ 1 NDEX ] ) 


IF  (LENGTH (SPECSl t INDEX!) >SPECS2t INDEX!)  THEN 

WHILE  <LENGTH(SPECS1 C INDEX!) -ySPECS^t INDEX! )  AND 
(POSC  '.SPECSlt  INDEX  !)  =  1)  DO 

DELETE (SPECSl C INDEX! , 1,1); 

IF  (LENGTH(SPECSUINDEX!)  >SPECS2CINDEX!)  THEN 

SPECS 1 C I NDE  X ! : =COPY  < SPECS  1 C I NDE  X ! , 1 , SPECB2  C I NDE  x ! )  : 

<••!♦*) 

END;  <*  End  GET  FIELD  NAME  •> 

PROCEDURE  GETWIDTh; 


VAR 

OPT:  <•  Menu  option  •) 

CHAR; 

BAD:  (•  Invalid  designator  •) 

BOOLEAN; 

(•«•••••«••••*«•«•«»»••*••»••••«•«•*«•••••«••••••««•••«•••*•«••••••«) 

<*  Internal  Procedures  *) 

(aa*****************************************************************) 


PROCEDURE  BADWIDTH; 

BEGIN 

WRITE (CHR (26)); 

BOTOX V (1,20) ; 

WR1TELN(CHR (IS) , ’WARNING: ’ , CHR ( 14) , 

’  You  must  enter  an  integer  between 
'1  and  ' .MAXSirt, ’ . ’ ,CHR(13) ) ; 

WRITE (’  11, ’Press  any  key  to  try  again  ’); 

G0T0XY(0,20) ; 

GETOPTION(OPT)  I 
ERASE (20,3); 

end; 


( 


) 


PROCEDURE  GOODWIDTH; 

BEGIN 

GOTOXY(0,9) i 

WRITELN(’Do  you  want  to  stay  with  CHR (15) .WIDTH, 
CHR(14),’  fields?’ ,CHR(13) ) ; 

WRITELN(’ Select  desired  option:’); 

WRITELN(’  1  -  Change  size’)! 

«R1TELN(’  2  -  Go  on  to  field  definition’); 

BETOPTION(OPT) 1 

WHILE  (OPTO’l’)  AND  (OPTO’ 2’)  DO 
BETOPTION(OPT) ; 

ERASE (7,7) ; 

IF  (OPT-’ 2’)  THEN 
BEGIN 

6PECS2C03:*WIDTH; 
bad: -FALSE; 


\ 
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END 


END 


<♦  Ham  body  o-f  GETWIDTH  *) 

. . . . . 


begin 

<*»!-*) 

bad:=true; 

WRITElN  (CHR  ( 12)  , 'How  many  variables  or  •fields 
’o-f  data  do  you  have'’’)} 

GOTOXY (0,5) ; 

WRITELN<’Enter  an  integer  O'f  ’.MAXSIZE, 

•  or  less: ’ ,CHR(7) ) j 

WHILE  (BAD)  DO 
BEGIN 

GOTOXY (0,7) ; 

RESET (INPUT) ; 

READ (WIDTH) ; 

IF  (10RESULT=14)  DR  (WIDTH<1)  DR 

(WIDTH>MAXSIZE)  THEN 

BADWIOTH 

ELSE 

GOODWIDTH; 

END;  (•  End  O'f  WHILE  loop  •) 

<•*!+*) 

ENOS  (•  End  O'f  GET  WIDTH  *) 


PROCEDURE  GETSPECSS 

VAR  opt;  char;  (*  Menu  option  *> 

<*  Internal  Procedures  •) 


PROCEDURE  INITIALENTRYf 
BEGIN 

WHILE  (INDEX<WIDTH>  AND  <C0LS<73)  DO 
BEGIN 

INDEX  :«INDEX4^1S 
row: -INDEX  ■•'6; 

GOTOXY (0, ROW) ; 

WRITE (INDEX: 7) I 

GETFLDWIDTHl 

BETFLDNAMEt 

END; 

IF  (XNDEX<WIDTH)  THEN 
BEGIN 


[ml 


WIDTH:=INDEX; 

GOTOxv ( 1 ,2o> ; 

MR1TELN(CHR( 15) , ’WARNING: ’ ,CHP ( 14) , '  You 

’•re  limited  to  WIDTH,’  variables.’, 
’  There  iBn’’t  room  -for  more  because’) 
WR1TELN(’  ’  :  1  1 ,  ’  you  haven’ ’t  le-ft  room  •for  ’, 
’more  on  the  SO-column  screen  line.’); 
WRlTEt’  ’;ll, ’Press  any  key  to  continue’); 
G0TOXV(0,2O) ; 

GETOPTION(OFT) ; 

ERASE (20,3) ; 

END: 

END; 


< 


) 


PROCEDURE  CHANGEDESIRED; 

BEGIN 

(*•1-*) 

ERASE (10,5) ; 

GOTDiV (0, 20) ; 

WRITELNC Enter  FIELD  to  change,  new  WIDTH,  ’, 

’and  new  NAME  (0  =  No  Change)’); 

ROW'.sie; 

GOTOXV (6, ROW) ; 

RESET (INPUT) ; 

READ (INDEX) ; 

WHILE  (I0RESULT=14)  OR  (INDEX<0)  OR  ( INDEX >WIDTH)  DO 
BEGIN 

B0T0XY(50,R0W)  ; 

WRITE(CHR(7)  ,CHR0  5)  ,  ’WARNING:  ’  ,  CHR  '  .4)  , 

’  Must  be  -from  0  to’ ,  W1 DTH:  3)  ; 

GOTOXV (60, ROW* 1 )  I 
WRITE (’Press  any  key’); 

G0T0XY(49,R0W)  ; 

GETOPTION(OPT)  ; 

G0T0XY(6,R0W) ;  (*  Erase  message  *) 

WRITE (CHR (29) ); 

GOTOXV (60, ROW+1) ; 

WRITE (CHR(29) ) ; 

GOTOXV (6, ROW) ; 

RESET (INPUT) ; 

READ (INDEX); 

END:  (a  End  O'f  Bad  Index  •) 

IF  (INDEXOO)  THEN  (*  Change  Field  *) 

BEGIN 

COLS ; ■C0LB-BPECS2  C I NDE  X  3 1 

getfldwidth; 

getfldname; 

ERASE (IB, 5); 

DIBPLAYBPECS; 

end: 
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(•  Allow  addition  «> 


IF  (C0LS<73)  THEN 
BEGIN 

GOTOXY(C>,  19) ; 

MRI TEln ( ’ Sel ect  daeired  option:’); 
WRITELN;*  1  -  Add  a  variable’); 

WRITElNC  2  -  Stay  with  ’.WIDTH, 

’  var i abl es’ ) ; 

GETOPTION(OPT) ; 

IF  (OPTO’l’)  AND  (0FT<>’2’)  THEN 
GETOPTION(OPT) : 

ERASE<19,3) ; 

IF  <OPT=’l')  THEN 
BEGIN 

G0T0XV(50,5) ; 

WRITE (CHR(15) , ’COLS  USED: ’ ,C0LS;3, 
'  COLS  LEFT: ’ , (SO-COLS) :3, 
CHR (14)); 

index: -width; 
width:-width+i; 

initialentry; 

END; 

erase  <7, 16) ; 

DISPLAYSPECS; 


GOTOXY (0, 19) ; 

WRlTELNC Select  desired  option;’); 
WRITELNC  1  -  Change  a  4ield’); 

WRITELN<’  2  -  Go  on  to  data  entry’); 

SET0PTI0N<0PT) ; 

WHILE  (OPTO’l’)  AND  (OPTO’ 2’)  DO 
GETOPTION(OPT); 


Main  body  o-f  GETBPECS 


BEGIN 

WIDTH:-SPECS2t03; 

C0LS:-0; 


<a  Initialize  parameters  •) 


WRITELN (CHR ( 12) . 'Now  enter  widths  and  names  4or  ’.WIDTH, 
’  •fields.  The  widths  ’  ,CHR(15) , ’must’ ,CHR(14) , 

’  be  at  least  B’ >  I 

WRITELN(’and  no  more  than  15.  This  includes  room  for  ’, 
'6  significant  digits.  Names’); 

WRITELN (’should  be  no  wider  than  their  field.  ’. 
’Finally,  remember  the  upper  limit’); 

WRITELN(’of  80  characters  per  record,  in  order  to  ’, 
'display  on  one  screen  line.’); 

S0T0XY(0,5> ; 

WRITE (CHR ( 15) , ’FIELD  NUMBER’ ,’ WIDTH’ : 9, 

’NAME’ :B,CHR(14> ) ; 


y. 

V. 

V. 

V. 


y. 


K«a 


y-- 

y.v. 

yv-'- 

I 


.v'ji 


G0T0XY<50,5)  ; 

WR1TELN(CHR (15) , ’COLS  USED: ’, COLS:  3,  ’  COLS  LEFT:’, 
<BO-COLS) :3,CHR(14) ) 1 


INDEX :=0; 
INITIALENTRY? 


WRITELN  (CHR  ( 12)  ,’ Current  spaci  F  i  cat  i  ons:  ’  )  ; 

BOTOXY (0,5)  ; 

WRITE <CHR< 15) , ’FIELD  NUMBER’ , ’WIDTH’  :9, 

’NAME’ :8,CHR(14) )  ; 

BOTOXY (50,5) ; 

WRITELN(CHR (15) , ’COLE  USED: ’, COLS: 3, ’  COLS  LEFT:’, 
(BO-COLS) :3,CHR(14) ) 5 


DISPLAYSPECSl 


BOTOXY (0, 19) ; 

WRITELNC Select  desired  option:’); 

WR1TELN(’  1  -  Change  or  add  a  <ield’>; 

WRITELN(’  2  -  Go  on  to  data  entry 

GETOPTION(OPT) 1 

WHILE  (OPTO’l’)  AND  (0PT<>’2’)  DO 
GETOPTION(OPT) ; 


WHILE  <0PT=’l’)  DO 

changedesired; 


END;  (•  End  oF  GET  SPECi Ficat i onS  «> 


PROCEDURE  GETDATA; 


VAR 

OPTl, 

(a  Menu  options 

a) 

K-:-. 

0PT2: 

char; 

cS 

name: 

(a  Field  name 

a) 

1 

STRING; 

DONE, 

(a  Completion  indicators 

a) 

FINISHED: 

BOOLEAN; 

a'-*.  • 

(eaaa 

*♦> 

(a 

Internal 

Procedures 

a> 

(aaaa 

aa) 

PROCEDURE 

printheading; 

BEGIN 

finished: -FALSE; 

WRITELN<CHR(12),’  ’ ; 30, CHR ( 15) , ’  DATA  ENTRY  ’, 
CHR(14) > ; 

NUMREC:  -NUMREC-^l ; 


<•  Data  File  Full 


IF  (NUMREC-MAXREC)  THEN 
BEGIN 

BOTOXY (0,20) I 

WRITELN<CHR(7>,CHR(15),’  WARNING:  This  la  ’, 


a) 
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a'*  a’*  a** 


)  .  ^  a  >  ■  .  » 


vVvy.*'. 


END 


the  last  data  entry  you  can  make'  ’ 
CHR ( 1 4 ) > ; 


BDTOXY (6,3)  ; 

WRITELN (CHR (15) , 'RECORD  #  ' , NUMREC , CHR ( 1 4 ) )  ; 
G0T0XY(0,5) ; 

WRITELN(’  FIELD’ , 'NAME' : 14, 'MAX  WIDTH’ : 1 1 VALUE 7)  ; 

WRITELN(  ’ - ’ ,  ’ - ’ :  14,  ’ - ’ :  1 1 ,  ’ - ’  :7) ; 

NAME:=SPECSltl3; 

IF  (LENGTH (NAME) ^15)  THEN 
NAME :=CORY (NAME, 1,15); 

WRITE (’ 1’ :4,NAME: 16,5PECS2C 1 D:7> 1 
GOTOXY (55,7) ; 

WR1TE(CHR(15),’<*  9999  to  *t op ’ , CHR ( 1 4 ) ) ; 

END; 


< 


PROCEDURE  PICKOFTION; 

BEGIN 

ERASE (20,3) ; 

GOTOXY (0,20); 

WRITELN (’ Bel ect  desired  option:’); 
WRITELN(’  1  -  Change  a  value’); 

WR1TELN(’  2  -  Enter  next  record’ >1 

GETOPTION(OPTI); 

WHILE  (OPTlO’l’)  AND  <0PT1<>’2’)  DO 
SETOPTION(OPTl)  ’, 

ERASE (20, 3); 

IF  <0PT1-’1’)  THEN 
CHANGE VALUE 

ELSE 

finished: -TRUE; 

end: 


<*  Main  body  o-f  GETDATA  *) 


BEGIN 

<asi-*) 

NUMREC: -o; 

done: -false; 


REPEAT 

PRINTHEADINGI 
row: -7 I 

GOTOXY (33, ROW) I 
RESET (INPUT); 

READ (VALUE)  ; 

WHILE  (IORESULT-14)  DO 
HANDLE INVALID; 

IF  < VALUE-9999.0)  THEN 

BEGIN  (•  Completion  indicator  •) 


done: -true; 

NUMREC:«NUMREC-1 ; 

SPECS2C - 1 3 : -NUMREC ; 

END: 

IF  NOT (DONE)  THEN  (•  Rroord  Entry  *) 

BEGIN 

GOTO* Y (55,9) ; 

WRITE (CHR (29; ) ; 

datacnumrec, n: -value: 

FOR  field:-2  to  width  do 
ENTERvALUEl 

END:  <•  End  oF  R*cord  Entry  •) 

while  (NOT (FINISHED) )  AND  (NOT (DONE))  DO 
F'ICKOFTION; 

UNTIL  (DONE)  OR  (NUMREC-HAXREC)  :  (•  End  O'*  REPEAT  *) 

(••I-r*)  (*  Turn  on  I/O  B#!  *  CHbcL  •) 

END:  (•  End  O'*  SET  DATA  «) 


(•  H«in  body  O*  GATHERDATA  •) 

<•••••••••••••••••••••••••••••••••••••••••••(»•••••••(»•••••••••••••••  ) 


BEGIN 

HRITELN(CHR(12) , '  ' :30,CHR ( 15) , •  DATA  ENTRY  ' , CHR ( 1 4 ) ) : 

BOTOXY (0,5) : 

WRITeuN(CHR (15) , ’  WARNING: * ,CHR( 14) , ’  One*  BRCtlon 

'i*  BtartBd,  d«t«  that  ha»  not  b»(rn  Bavbd’): 

WRITELN(’  to  d>Bk  via  tha  BAVEFIlE  procadura 

’may  ba  contanitnatad.  ’  )  : 

sotoxy (0, 10) : 

WRITELN ( ’ Sal  act  dasirad  option:’): 

WRITELNC  1  -  Start  data  antry’); 

HRITELN(’  2  -  E-it  thia  procadura’): 

SETOPTION(OPT) : 

WHILE  (OPTO'l’)  AND  (OPTO' 2’)  DO 
BETOPTION(OPT) ; 

IF  <0PT-’l')  THEN  (•  Accapt  data  •) 

BEGIN 

setwidth: 

bf^tpecs: 

ta: 

END 

END:  (a  Er  J  'FR  DATA  a) 


UHIT  nU_B;  INTRINSIC  CODE  12 


INTERFACE 

USES  TRANSCEND,  MAIN_LINIT; 

PROCEDURE  COMPUTE <VAR  DATA: RAWDATA; VAR  SPECS! : HEADER 1 ! 

VAR  SPECS2:HEADER2! INDEX: INTEGER) ; 

PROCEDURE  RECODE (VAR  DATA: RAWDATA; VAR  SPECS!  :  HEADER!  ; 

VAR  SPECS2:HEADER2; index; INTEGER)  ; 


IMPLEMENTATION 


(•«•*••«*••««•*•*•*•••«•••«•••••••«••»•«*•«•••«•••**•«••••••••••*••«) 

<*  Main  body  o-f  UNIT  MU_B  *) 


PROCEDURE  COMPUTE; 


»*) 
*) 
•  ) 
*) 
*) 
•  ) 
»*) 


This  procedure  41118  the  indexed  Field  in  the  data 
array  with  a  computation  based  on  one  or  tMO 
Fields  /  user  input  constants  and  one  operand. 


VAR 


I. 

(a 

Iteration  counter 

a> 

NUMREC, 

(* 

Number  oF  records 

a) 

VAR!, 

(• 

1st  or  only  var i ab 1 e 

a) 

VAR2, 

(a 

2nd  variable,  IF  req. 

al 

width: 

integer; 

(a 

Number  oF  Fields 

a) 

NUMl, 

(a 

1st  or  only  constant 

a) 

NUM2, 

(a 

2nd  constant,  iF  req. 

al 

VALUE: 

real; 

(a 

Computed  value 

a) 

OPT, 

OPT!, 

0PT2, 

(a 

Menu  options 

a) 

OPERAND: 

CHAR; 

(a 

Selected  operation 

a) 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaeaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

(*  Internal  Procedures  *) 

<eaaae***aaaaaaaaaaaa»aaaasaaaaaaaaaaaasaaaaaaaaaaaaaaaaa«aa«aaaaaa«) 


PROCEDURE  PICKOPTION; 

BEGIN 

B0T0XY(0,S) I 

NRITELN( ’ This  routine  works  by  perForming  a  computation  ' 
'based  on  one  or  two  Fields'll 
WRITELN( 'and/or  user  input  constants  and  one  operand  '• 
etc. ) .  Any  undeFined’H 

HRITELN< 'results  will  be  stored  as  99.9999.  See  user”s 
'guide  For  InFormation  on  running'll 


WRITELN  ( ’  thi  *  procedure  more  then  once  -for  2  or  more 
*  oper at i one. ’ ) ; 

BOTOXY (0, 10) ; 

WRITELN ( ’ Sel ect  desired  option:’); 

WRITELNC  1  -  Proceed  with  COMPUTE’); 

WRITELNC  2  -  Exit  COMPUTE  FIELD’); 

BET0PTI0N<0PT) ; 

WHILE  (OFTO’l’)  AND  <0PT<>'2’>  DO 
GETDFTION(OPT) ; 

END;  (•  End  o4  SELECT  OPTION  *) 


< 


) 


PROCEDURE  USEFIELD(0PT:CHAR;V/AR  INDEX : INTEGER) ; 

BEGIN 

<*»I-«) 

IF  (0PT=’l’)  THEN 

WRITECEnter  index  oF  1st  variable:’) 

ELSE 

WRITECEnter  index  oF  2nd  variable:’); 

WRITELNC  <1  -  ’.width, ’>’,CHR(13))i 
RESET (INPUT) I 
READ ( INDEX ) ; 

WHILE  <10RESULT-14)  OR  <INDEX<1)  OR  ( INDEX >WIDTH)  DO 
BEGIN 

BOTOX Y( 1,20)  1 

WRITELN<CHR(15) , 'WARNING: ’ ,CHR(14) , 

’  Must  be  an  integer  between 
’1  and  WIDTH, CHR(13) ) ; 

WRITEC  ’111, ’Press  any  key  to  try  again  ’); 
B0T0XY<0,20); 

BET0PTI0N<0PT2) 5 
ERASE (20,3) 1 
ERASE (12, 4) ; 

B0T0XY(0, 12) i 
RESET (INPUT); 

READ ( INDEX ) ; 

END;  <•  End  oF  Bad  Index  a) 

<*•1+*) 

END;  (•  End  oF  USE  FIELD  •) 


< 


) 


PROCEDURE  USENUMCONST (VAR  NUM:REAL)| 

BEGIN 

(eai-e) 

WRITELN(’ Enter  a  number: ’ ,CHR ( 13) ) ; 

RESET (INPUT) | 

READ(NUM) I 

WHILE  (IORESULT-14)  DO 
BEGIN 

WRITE(CHR(26))I 
BOTOX Y (1,20)1 

WR1TELN(CHR( IS), ’WARNING: ’ ,CHR(14)  , 

’  Must  be  a  number.  ’  iCHRdS) )  I 
write;’  ’;il,’Pre»s  any  key  to  try  again’); 
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B0T0XY<0,20); 

BET0PT10N(0PT2)  ; 

ERASE (20, 3>; 

B0T0XY(0, 12) f 
RESET ( INPUT) ; 

READ(NUM) ; 

ENDi  (•  End  04  Bad  Number  a) 

END:  (•  End  o4  USE  NUMber  or  CONSTant  a) 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

PROCEDURE  SELECTOPERAND; 

BEGIN 

ERASE (S.B) ; 

B0T0XY(0,5)  : 

WRITELN(CHR(15), '  SELECT  DESIRED  OPERAND: CHP ( 1 4) )  ; 
writeln; 

WRITELN ( ’ These  require  a  second  variable:’); 


WRITELN (’ 

A 

- 

Add! ti on 

(+)  ’): 

WRITELN (’ 

B 

- 

Subtraction 

(-)  ’); 

WRITELN ( ’ 

C 

- 

Mul tipi i cati on 

(a)  '  )  ; 

WRITELNC 

D 

- 

Division 

(/)  ’>; 

writeln: 
WRITELN (’These 

operate  on  the  first 

variable: ’ ) : 

WRITELN (’ 

E 

- 

Square 

(SOR)  ’>: 

WRITELN (’ 

F 

- 

Square  Root 

(SORT)  ’): 

WRITELN (’ 

6 

- 

Natural  Log 

(LN>  ’): 

WRITELN (’ 

H 

- 

Log  Base  10 

(LOG)  ’>: 

WRITELN (’ 

I 

- 

Exponential 

(EXP)  ’): 

WRITELNC 

J 

- 

Absolute  Value 

(ABS)  '): 

WRITELN (’ 

K 

- 

Truncate 

(TRUNC)  ’)» 

WRITELN (’ 

L 

- 

Round 

(ROUND)  ’>: 

BET OPT I ON (OPERAND)  I 

WHILE  <OPERAND<’A’ )  OR  <OPERAND>’ L’ )  DO 
IF  <OPERAND<'a’ )  OR  (OPERAND >’ I ’ >  THEN 
BEGIN 

B0T0XY(0,S) 1 

WRITELN<CHR(15) , ’  BAD  DESIBNATOR. 

'TRY  AGAIN.  ’,CHR(14)>; 

SETOPT I ON (OPERAND) l 

END 

ELSE  (*  Convert  to  capitals  •> 

OPERAND ; -CHR ( DRD ( OPERAND ) -32 )  ; 

ERASE (5, IB) : 

B0T0XY(0,5) » 

END: 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

PROCEDURE  TWOVARl 
BEGIN 

IF  (VAR1>0)  THEN 

WRITE(8PECSUVAR1].'  ') 


WRITE (NUMJ :4;4, •  •)» 

CASE  (OPERAND)  OP 

'A*;  WRITEC+  •)! 

•B';  WRITEC-  ')! 

'C':  WRITEC*  ')» 

•O’:  WRITE(’/  ')( 

end;  («  End  o-f  CASE  •) 

IF  (VARD^O)  THEN 

WR I TELN  <  SPECS 1 C  VAR2 3 ) 

Else 

WRITELN  <NUM2: 4: 4) ; 

END;  <*  End  oi  TWO  VARi*bl*  comput*  *) 


PROCEDURE  ONE VAR; 

BEGIN 

CASE  (OPERAND)  OF 

•E’:  WRITE (’SOR  (*); 

•F’:  WRlTECBQRT  (•>; 

•S’:  WRITECLN  (')( 

'H';  WRITECLOG  (’>; 

•I';  WRITE(’EXP  ('); 

•J';  WRITE  CABS  C)| 

•K':  WRITE  CTRUNC  C)| 

•L’;  WRITE(’ROUND  C)| 

END;  («  End  o^f  CASE  •) 

IF  (VAR1>0)  THEN 

WRITELN (SPECS It VAR n, ’ > ' > 

ELSE 

WRITELN<NUM1 :4:4,  '  )')| 

END;  (*  End  o-f  ONE  VARiabl*  computw  *) 


PROCEDURE  DOCOMPUTE; 

BEGIN 

(••R  TRANSCEND  *)  <•  R*t*ln  UNIT  In  Memory  •) 

80T0XY(0,20) ; 

WRITE (’ Computi ng .  .  . 

FOR  l;-l  TO  NUMREC  DO 
BEGIN 

IF  (VARI>0)  THEN 

MUf1l:-DATAtI,VAR13l 
IF  (VAR2>0)  THEN 

NUn2 : -DATA C I , VAR2 3 I 

CASE  (OPERAND)  OF 

•A*;  VALUE:-l«JHl*NUn2l 
'B';  VALUE :-NOm-NUM2; 

'C:  VALUE :-WJni*NUN2; 

•D’;  IF  (NUH2-0.0)  THEN 
value: -99. 9979 

ELSE 


value: -NUMl /NUM2; 
•E’:  VALUE : ■SOR <NUM1 )  ; 

•F’:  IF  <NUM1<0.0)  THEN 
VALUE: -99. RRRR 

ELSE 

VALUE : -SORT ( NUn 1 ) ! 
•G*;  IF  <NUMl<-0.0>  THEN 
VALUE: -99. 9999 

ELSE 

VALUE :-LN( NUMl  )  ; 
'H':  IF  <NUMl<-0.0)  THEN 
VALUE: -99. 9999 

ELSE 

VALUE: -LOG (NUMl) ; 
•I’:  value: -EXP (NUMl ) ; 

•J':  VALUE: -ABS (NUMl ) 1 
'K':  value: -TRUNC (NUMl ) 1 
•L':  value: -ROUND (NUMl ) ; 
end;  <•  End  o*  CASE  •) 

DATA  C I , I NDE  X  3 : -VALUE ; 

END; 


end;  <*  End  o*  DO  the  COMPUTE  *) 

<*  Main  body  o^f  COMPUTE  •> 


BEGIN 

NUMREC:-SPECS2C-13;  <*  Initialize  parameters  *> 

width: -SPECS2t03; 

VARi;-o; 

VAR2:-o; 

WRITELN(CHR(12) , '  ' ; 25, CHR ( 15) , '  COMPUTE  FIELD  ROUTINE 
CHR(14> ) I 

PlCKOPTIONi 

IF  <OPT-’l')  THEN  (*  Proceed  with  Compute  *> 

BEGIN 

ERASE (S,B) ; 
e0T0XY<0,5) f 

WRITELN(’ Select  desired  option: '>; 

HRITELNC  I  -  Identify  4ield  o4  1st  variable’); 

MR1TELN(’  2  -  Enter  a  number  (constant )’) I 

BET0PTI0N(0PT1)| 

WHILE  (OPTlO'l’)  AND  (OPTIO’2’)  DO 
BeTOPTION(OPTl>I 

e0T0XY(0, 10) I  (*  Get  First  variable  •) 

IF  (OPTl-’l’)  THEN 

U6EF I ELD ( OPT 1 , VAR 1 ) 

ELSE 

UBENUMC0N6T (NUMl ) I 
6ELECT0PERANDI 

IF  (0PERAN0<’E* >  T4CN  (•  Bet  second  variable  a) 

BEGIN 


w, 


WRITELN(*B»lect  desired  option;’); 

WRITELNC  1  -  Identify  •field  O'f 

’2nd  ver i ab 1 e ’ ) ; 

WRITELN('  2  -  Enter  a  number’); 

GET0PT10N(0PT2) ; 

WHILE  (0PT2<>’1’)  AND  (0PT2<>’2’)  DO 
SET0PTI0N<0PT2) ; 

GOTO)(Y  (0,  10)  ; 

IF  <0PT2=’l’)  THEN 

USEF1ELD(’2’ ,VAR2) 

ELSE 

USENUnCONST ( NUn2 ) ; 

END;  (a  End  o-f  Get  Second  Variable  •) 

ERASE (S,8) : 

G0T0XV<0,5); 

WR1TELN<CHR(15),’  COMPUTATION  SELECTED: ’, CHR ( 14 )) ; 
G0T0XY(25,10)I 

IF  <0PERAND<’E’ )  THEN  (•  Display  computation  *) 

TWOVAR 

ELSE 

ONEVAR; 

GOTOXYiO.lB); 

WR I TELN <’ Select  desired  option:'); 

HRITELN<’  »  -  Proceed  with  COMPUTE’); 

WR1TELN<’  2  -  Skip  this  COMPUTE’); 

GETOPTION(OPT) ; 

WHILE  (OPTO’l’)  AND  <DPT<>’2’)  DO 
GETOPTIONCOPT) ; 

ERASE <5, 16); 

IF  <0PT-’l’)  THEN 

ddcompute; 

END;  (a  End  O'f  Proceed  with  Compute  a) 

END;  (a  End  O'f  COMPUTE  a) 


(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaasaaa*****#**#************) 

<a*I  PSPPlRECODE  a)  (a  Include  procedure  in  UNIT  a) 


(a 

(a 

(a 


Initialization  part  of  UNIT 


■a) 

a) 

a) 


PROCEDURE  RECODE; 


(••«•*•••••••••••••«••••••••••••••••••••••••»««»«•**•«*•••««««•»••••) 

(*  *) 

<•  This  procsdure  fills  the  indexed  field  in  the  data  •> 

<•  array  Mith  user  input  constants  based  on  •) 

<•  partitions  within  that  or  a  different  field.  •) 

<a  *) 


TYPE 

BUPFER*ARRAVC 1 . .HAXREC3  OF  REAL; 


<a 

<* 

(• 


VAR 


FIELD, 

(* 

Field  recoding  is  based  on 

a) 

I, 

(* 

Iteration  counter 

a) 

NUMREC, 

(a 

Number  of  records  in  file 

a) 

width: 

INTEGER; 

(• 

Number  of  fields  in  file 

a) 

BOTTOH, 

(a 

Bottom  edge  of  partition 

a) 

TOP, 

(a 

Top  edge  of  partition 

a) 

VALUE: 

real: 

(a 

Recoded  value  in  partition 

a) 

NEWFIELD: 

buffer; 

(a 

Temporary  recoded  field 

a) 

OPTO, 

OPTl, 

0PT2, 

0PT3, 

(a 

Menu  options 

a) 

extreme: 

CHAR; 

(a 

End  point  indicator 

a) 

DONE, 

(a 

Completion  indicator 

a) 

HIGHEST, 

(a 

High  end  point  used 

a) 

LOWEST: 

boolean; 

(a 

Low  end  point  used 

a) 

Internal  Procedures  *) 


PROCEDURE  DISPLAY INSTRUCT IONS; 

BEGIN 

WRITELN(CHR<12) : 25,CHR < 15) , '  RECODE  FIELD  ROUTINE 
CHR(14) } I 

B0T0XY<0,5>  J 

WRITELN ( ’ Thi a  routine  works  by  partitioning  the  data 
’of  a  specified  field  based’ >; 

WRITELN (’on  range (s>  between  two  endpoints.  You  ’, 
'have  the  option  of  entering’ >; 

WRITELN (’numeric  endpoints  or  using  the  values  ’, 
’LOWEST  and  HIGkCST.  Those  points’) I 

WRITELN(’lndicate  the  two  extremes  of  the  data  ’, 
’field. ’,CHR(13))I 

WRITELN (’NOTE:  Once  started,  you  can  not  leave  ’, 

’this  routine  without  using  LOWEST*); 

WRlTELN(’and  HIGHEST  at  least  once.  See  user”s  ’, 
’guide  for  further  information.’); 

e0T0XY(0,20) ; 
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WRITElN ( ’ Sel Bct  desired  option:’); 
WRITElNC  1  -  Proceed  with  RECODE’); 

WR1TELN(’  2  -  Exit  RECODE  FIELD’); 

BETOFT ION (OPTO) ; 

WHILE  (OPTOO’l’)  AND  (OPTO<>’2’)  DO 
BETOFT I  ON (OPTO) ; 

ERASE (5,7) ; 

ERASE (20,3) ; 

END;  <*  End  o-f  DISPLAY  INSTRUCTIONS  •) 


< 


) 


PROCEDURE  6ETPIELD; 

BEGIN 

(•♦1-*) 

G0T0XY(0,5) ; 

WRITELN  (’ Enter  'field  to  use  in  recoding:  (1  - 
WIDTH, ’ ) ’ ,CHR (13) ) ; 

RESET (INPUT) ; 

READ (FIELD) ; 

WHILE  ( IORESULT-14)  OR  <FIELD<1)  OR  (F1ELD>WIDTH)  DO 
BEGIN 

G0T0XY<1,20); 

WRITELN(CHR(15) , ’WARNING: ’ ,CHR( 14)  ,  ’  Bed  ’, 
'index.  Enter  an  integer  between  ’, 
•1  end  WIDTH, CHR(13) ) ; 

WRITELN (’  '111, 'Press  any  key  to  continue’); 
B0T0XY(0,20) ; 

BET0PT10N(0PT2)  ; 

ERASE (7, 16); 

B0T0XY<0,7) ; 

RESET (INPUT); 

READ (FIELD) ; 

end; 

(•»i**) 

end;  <•  End  of  BET  FIELD  •) 


PROCEDURE  BETOPTl; 

BEBIN 

ERASE (S, 3) ; 

BOTOXY (0,5) ; 

WRITELN (’Select  desired  option:’); 
WRITELN(’  1  -  Enter  a  partition’); 

WRITELN <’  2  -  Exit  RECODE  FIELD’); 

BETOPTION(OPTl) ; 

WHILE  (OPTlO’l’)  AND  (0PT1<>’2’)  DO 
BET0PTI0N(0PT1>; 

EXTREME:-’  ’; 

end; 


PROCEDURE  BETBOTTOMOPTION; 


BEBIN 


ERASE (5,3) ; 

GDTOXY (0,5) ; 

WRlTELNCSct  partition  bottom  edge  using;’); 
WRITELN(’  1  -  Numeric  endpoint’ >» 

WRITELNC  2  -  LOWEST  value’); 

eET0FTI0N(QPT2) ; 

WHILE  <0PT2<>’1’)  AND  (DPT2<>’2-'  DO 
GET0PT]0N(0PT2) ; 

END; 


( 


) 


PROCEDURE  GETTOPOPTION; 

BEGIN 

ERASE (5, 3); 

G0T0*Y(0,5) ; 

WRlTELN(’Set  partition  top  edge  using:’); 
WRITELNC’  1  -  Nume'-ic  endpoint’); 

WRITELNC’  2  -  HIGHEST  value’); 

GET0PT10N(0FT2) 1 

WHILE  (0PT2<>’1’)  AND  <OPT2<>’2’>  DO 
GET0PTI0N(DPT2) ; 

END; 


< 


) 


PROCEDURE  NUMERICBOTTOM; 

BEGIN 

<a*I-*) 

Goroxy<o,  to  t 

WRITELNC ’Enter  lower  endpoi nt I ’ , CHR ( 1 3) )  ; 

RESET (INPUT); 

READ (BOTTOM)  ; 

WHILE  <IORESULT«14)  DO 
BEGIN 

G0T0XY(J,20) J 

WRITELN (CHR ( 15> , ’warning: CHR (14)  ,  ’  Must  ’, 
’be  a  number CHR ( 13) > ; 

WRITELNC’  ’:il, ’Press  any  key  to  try  again.’); 
B0T0XY<0,20) ; 

GET0PTI0N(0PT3> 1 
ERASE (12, 11); 

GOTOXYCO, 12) ; 

RESET (INPUT); 

READ (BOTTOM) ; 

END;  (a  End  oF  Bad  Bottom  •) 

ERASE (10,3) ; 

<a*I'*-*) 

END;  <a  End  oP  NUMERIC  BOTTOM  a) 


( 


) 


PROCEDURE  NUMERICTOP; 

BEGIN 

(a*l-a) 
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GOTOXY (0, 10) ! 

WRI TELN (’ Enter  upper  endpoi nt : ’ , CHR < 1 3 ) ) ; 

RESET (INPUT) ; 

READ (TOP) ; 

WHILE  (I0RESUlT=14)  OR  (TOP<BDTTOM)  DO 
BEGIN 

GOTOXY (1,20) ; 

WRITELN (CHR ( 15) , ’WARNING: ’ , CHR (14),’  ’ , 

’Must  be  a  number  greater  than  ’, 
bottom: 6: 5, CHR (13) ) ; 

WR1TELN(’  ’:ll, ’Press  any  key  to  try  again.’); 
GOTOXY (0,20) ; 

GE'T0PTI0N(0PT3)  ; 

ERASE (12,11); 

GOTOXY (0, 12) ; 

RESET ( INPUT) ; 

READ (TOP) ; 

END;  <*  End  o-f  Bad  Top  *) 

ERASE ( 10,3) ; 

(*•1+*) 

END;  (*  End  of  NUMERIC  TOP  *) 


< 


PROCEDURE  GETRECODER; 

BEGIN 

<••1-*) 

WRITELN(’Enter  value  to  recode  partition  with:’); 

ERASE (6, 2); 

RESET (INPUT) ; 

READ (VALUE) ; 

WHILE  <I0RESULT=14)  DO 
BEGIN 

WRITE (CHR (26) ) ; 

GOTOXY (1,20) ; 

WRITELN(CHR(15) , 'WARNING; ’ ,CHR( 14) , ’Must  be  ’, 
’ a  number . ’ , CHR ( 1 3 ) ) ; 

WRITELN(’  ’:ll, ’Press  any  key  to  try  again.’); 
GOTOXY (0,20) ; 

BET0PTI0N(0PT3)  ; 

ERASE (20,3); 

B0T0XY(0,B) ; 

RESET (INPUT) ; 

READ (VALUE); 

END;  (•  End  of  Bad  Value  •) 

<**I*a) 

END)  (a  End  o-f  GET  RECODER  *) 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaeaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa 


PROCEDURE  VIEWRECODE; 

BEGIN 

ERASE (5, 4) I 

WRITELN (’Partition  is: ' , CHR ( 13) ) ) 

WRITE- (’  Recode  ’)» 

IF  (EXTREME=’L’ )  OR  (EXTREME^* B’ )  THEN 


Il4 


WRITE (’LOWEST’ ) 


ELSE 

WRITE (BOTTOM: 6: 4) ; 

WRITE ( ’  to  ’ ) ; 

IF  <EXTREME  =  ’H’ )  OR  (EX'^REME* ’  B ’  )  THEN 
WRITE (’HIGHEST’ ) 

ELSE 

WRITE (T0P:6: 4) ; 

WRITEi^NC  with  ’  ,  VALUE:  6;  4,CHR  ( 13)  ,CHR  (  13>  )  ; 

WR I TELN < ’ Sel cc t  desired  option;’); 

WRITELN(’  1  -  Proceed  with  RECODE’); 

WRITELN(’  2  -  S(.ip  this  RECODE’): 

GETOPTION(OPT3) ; 

WHILE  (0PT3r>’l’)  AND  (OPT3<>’2')  DO 
GET0RTI0N(0PT3) ; 

ERASE ( 14,3) ; 

END;  (*  End  o-f  VIEW  RECODE  *) 


PROCEDURE  DORECODE; 

BEGIN 

GOTOXY (0,20) ; 

WRITE (’Recoding.  .  .  ’); 

CASE  (EXTREME)  OF 
'  FOR  l:=l  TO  NUMREC  DO 

IF  (DATAC1,FIELD:>BDTT0M)  AND 

(Dataci,field:<=top)  then 

NEWF I ELDt I  3 : =VALUE ; 

’L”.  FOR  l:  =  l  TO  NUMREC  DO 

IF  (DATAtI,FIELDD<»TOP)  THEN 
NEWF I ELDt I  3 : -VALUE  I 
’H’:  FOR  l;-l  TO  NUMREC  DO 

IF  (DATACI,FIELD3>r-3TTOM)  THEN 
NEWF I ELDt I  3 :  -  VALUE ; 

•B’:  FOR  l:=l  TO  NUMREC  DO 

NEWFIELDt 33:-VALUE; 
end;  <♦  End  o-f  CASE  *) 

ERASE (20, 1); 

END;  <*  End  o-f  DO  the  RECODE  «) 


PROCEDURE  MAKESAVEFINAL; 

BEGIN 

ERASE (5,3) ; 

GOTOXY (0,5) ; 

WRI TELN (’ Gel ect  desired  option:’); 
WRITELN(’  1  -  Save  the  RECODE’); 

WRITELN(’  2  -  Exit  without  saving’); 

BET0PTI0N(0PT2) I 

WHILE  <0PT2<>’1’)  AND  (0PT2<>’2’>  DO 
BET0PTI0N(0PT2) ; 

IF  <0PT2-’l’)  THEN 
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BEGIN 

EOTOXY (0, 15) ; 

WRITELNC’ Saving.  .  .’)} 

FOR  l:  =  l  TO  N'JMREC  DO 

DATAt I , INDEX3:=NEWFIELD[ 135 

END; 

END:  (•  End  o-r  MAKE  SA)/E  FINAL  •> 


<*  Main  body  o-f  RECODE  *) 


BEGIN 

NUMREC: *SPECSr C -1 3 ;  <•  Initialize  parameters  *) 

width: -SPECS2C03i 
DONE: =FALSE; 

highest:«false; 

LOWEST; -FALSE; 

DI SPLAY INSTRUCT  IONS; 

IF  <0PT0=’l’)  THEN  (#  Get  ■field  to  partition  on  *) 

GETFIELD 

ELSE 

done:=true; 

WHILE  NOT (DONE)  DO  (•  Do  a  Recode  •) 

BEGIN 

GETOPTl; 

IF  <0PTl=’l’)  THEN  (*  Get  partition  range  *) 

BEGIN 

getbottomoption; 

IF  <0PT2»’1’>  THEN  (•  Numeric  bottom  •) 

NUMERICBOTTOM 

ELSE 

BEGIN  (*  LOWEST  bottom  a) 

EXTREME: =’L’ ; 
bottom:— MAX  I  NT; 

LOWEST; -TRUE: 

end; 

GETTOPOPTIDN; 

IF  <0PT2-’l')  THEN  (•  Numeric  top  *> 

NUMERICTDP 

ELSE 

BEGIN  (•  HIGHEST  top  •) 

IF  (EXTREME-’L’ >  THEN 

EXTREME: -’B’ 

ELSE 

EXTREME; »’H’ ; 

TOP: -MAX  I NT; 

HIGHEST: -TRUE; 

END; 

•  ) 


B0T0XY(0,5) ; 
GETRECODER; 


(•  Recode  value 


G0TDXY(0,5>!  (*  Display  recode  *) 

viemrecode; 

IF  <0PT3=’l’)  THEN 
DORECODE; 

ERASE <5, 8>; 

END 

ELSE 

IF  (HIBHEST)  AND  (LOWEST)  THEN 
DONE: = TRUE 

ELSE 

BEGIN 

G0T0XY(1,20); 

WRITElN<CHR<15) , 'WARNING:  ’  ,CHR(  14)  , 

'  Must  reference  both  HIGHEST 
'end  LOWEST  once  each . ’ , CHR ( 1 3) ) ; 
WRITELNC  11, 'Press  any  key  to 
'continue' ) ( 

G0T0XY(0,20>  1 
GET0PTI0N(0PT2) 5 
ERASE (20,3) 5 

end; 

end;  (•  End  ot  Do  a  Recode  •> 

IF  <0PT0<>'2')  THEN 

makesavefinal; 


END;  (•  End  o*  RECODE  •> 


INTERFACE 

USES  main_unit; 

PROCEDURE  HANDLE  INVALID (VAR  VALUE: REAL r ROW: INTEGER) ; 

PROCEDURE  ENTERVALUE (VAR  DATA: RAWDATA; VAR  SPECS 1  :  HEADER  1  ; 

VAR  SPECS2:HEADER2;  index, FIEi-D:  INTEGER)  ; 

PROCEDURE  CHANGE  VALUE  (VAR  DATA:  RAWDATA;  INDEX  ,  WIDTH:  INTEGER) 

PROCEDURE  SUBARECORD(VAF  DATA: RAWDATA; VAR  SPECS 1 : HEADER  1 ; 

VAR  BPECS2:HEADER2)  ; 

PROCEDURE  ADDARECORD (VAR  DATA: RAWDATA;  VAR  SPECS! : HEADER!  ; 

VAR  SPECS2;HEADER2) ; 

PROCEDURE  CHGARECORD(VAR  DATA: RAWDATA; VAR  SPECS! : HEADER! ; 

VAR  SPECS2:HEADER2) ; 

PROCEDURE  SUBAFIELD (VAR  DATA: RAWDATA! VAR  SPECS! : HEADER! 5 
VAR  BPECS2:HEADER2> J 

IMPLEMENTATION 


(*  Mam  body  O'f  MU_C  •) 


PROCEDURE  HANDLEINVALID5 

VAR  OPT:  CHAR!  (•  Menu  option  *> 

BEGIN 

(*•!-*) 

G0T0XY(1,20) ! 

WRITELN(CHR (15) , 'WARNING: ’ ,CHR(14) , ’  Veluemust 
'be  •  number.  Press  any  key  to  continue’); 

B0T0XY(0,20) 5 
BETOPTION(OPT) ! 

ERASE(20,1); 

G0T0XY(33,R0W) ! 

WRITELN<CHR(29) ) I 
60T0XY(33,R0W) ; 

RESET ( INPUT ) ! 

READ (VALUE) I 

(a»l4.«) 

END;  (•  End  o-f  HANDLE  INVALID  •) 


PROCEDURE  ENTERVALUE; 

VAR 

row:  <•  Row  on  screen  •) 

INTEGER; 

VALUE:  <•  Data  value  as  entered  •) 


real: 

NAME:  (•  Fi*ld  riame  *) 

STRING; 

BEGIN 

<*•:-*) 

R0W:=FIELD*8; 

GOTOxy (0,row) ; 

NAME:«:SPECS1  CFIELDJ; 

IF  (LENGTH(NAME) >15)  THEN  (•  Truncate  names  to  4jt  *) 

NAME :=COPY (NAME, 1,15); 

WRITELN(FIELD:4,NAME: 16,SPECS2tFIELDl:7) ; 

GOTOXY (33, ROW) ; 

RESET (INPUT) ; 

READ (UAL UE) ; 

WHILE  (IORESULT=14)  DO 

HANDLEINVAL ID (VALUE, ROW) ; 

DATA  tlNDEX, FIELD!: -VALUE ; 

<«*!+*) 

END;  («  End  o-f  ENTERVALUE  *) 

(#•••«••••«•«••«••••«•««••••«••«••••••*««••«««•«••**••••••••••••••••> 

PROCEDURE  CHANGEVALUE; 

VAR 


FIELD, 

<•  Field  to  change 

a) 

row: 

INTEGER; 

<•  Row  on  screen 

a) 

VALUE: 

real; 

<•  Data  value  to  be  stored 

a) 

OPT: 

char; 

(a  Menu  option 

a) 

BEGIN 

ERASE  (19,)))  ; 

GOTOXY (0, 19) ; 

WRITElN( 'Enter  .field  to  change:  (1  -  ’, WIDTH, ; 
WRITELNC  <0  -  Skip  change)’); 

RESET (INPUT) ; 

READ(FIELD) f 

WHILE  <I0RESULT=14)  OR  <FIELD<0)  OR  (FIELD>WIDTH)  DO 
BEGIN 

GOTOXY (0,22) I 

WRITE (CHR (7) , ’ Bad  field  number.  Press  any 
'key  to  try  again  ’); 

SETOPTION(OPT) ; 

ERASE (21, 2); 

GOTOXY<0,21) I 
RESET (INPUT) I 
READ (FIELD) ; 

END;  <a  End  of  Invalid  IndeK  •) 

ERASE (19, 4) I 


IF  (FIELDOO)  THEN 


(a  Hake  change  •) 


BEGIN 

RDW:=FIELD+B; 

GOTOXV (33,R0W)  ; 

WRITEC  • :23,CHR<15) , *<«  Enter  new  v«l ue' , CHR ( 14 ) > ; 

eOTDXY (33,R0W)  ; 

RESET (INPUT) ; 

READ ( VALUE ) ; 

WHILE  <10RESULT=14)  DO 

HANDLE INVALID (VALUE, ROW)  ;  ; 

datacindex,fieldi:=value; 

G0T0XY(56,R0W' 5 
WR1TELN(CHR<29)); 

END; 

(*•1+*) 

END;  (•  End  o-f  CHANGE  VALUE  •) 


PROCEDURE  SUBARECORD: 


•  > 
•  > 
•  ) 
•  ) 
*) 
•  > 
»•> 


This  procedure  removee  one  record  From  e  File  by 
overwriting  it  with  the  last  record  in  the 
File  and  decrementing  NUHREC;  the  Number  oF 
Records  counter  stored  in  BPECS2i;-13. 


VAR 


1. 

(# 

Iteration  counter 

a) 

INDEX, 

(a 

Record  to  remove 

a) 

NUHREC, 

(a 

Number  oF  records 

a) 

width: 

INTEGER; 

(a 

Number  oF  Fields 

a) 

OPTl, 

0PT2; 

CHAR; 

<a 

Henu  options 

a) 

(a  Internal  Procedures  •) 


PROCEDURE  BAD INDEX; 

BEGIN 

(atl-a) 

G0T0XY(1,20); 

WRITELN(CHR(15), ’WARNING:’, CHR(14),'  Bad  index.  ’, 
’Enter  an  integer  between  1  and  ’, 
NUMREC,’.’,CHR(13>>; 

WR1TELN(’  11, ’Press  any  key  to  try  again.’); 

eOTOXY (0,20) I 

8ET0PTI0N<0PT2); 

ERASE (8, 15) I 
60Toxv(o,e) ; 

RESET (INPUT) I 


120 


READ (INDEX) ; 

(••I**) 

END:  (•  End  o-:  B«d  Ind^x  •) 


< 


) 


PROCEDURE  VIEWRECORD; 

BEGIN 

G0T0XY(0,B) ; 

WRITE ICHR ( 13) , ’  RECORD  «  ’.INDEX,’  ’,CHR(14)); 

GOTOXV (0, 10) ; 

FOR  1:b1  to  width  DO  (•  Display  ‘field  names  •) 

WRITE<SPECSltl3:SPECS2Cn,’  ’>; 

writeln; 

FOR  I:*l  to  width  do  (*  Display  the  record  *) 

WRITE (DATAC INDEX, n:SPECE2C I  3:4, ’  ’ ) ; 

writeln; 

END; 


< 


) 


PROCEDURE  DOREMOVE; 

BEGIN 

FOR  l:«l  TO  WIDTH  DO 

DATAt INDEX, 13; -DATAtNUHREC, 13; 
BPECS2  C - 1 3 : -NUMREC- 1 f 
END:  <a  End  o^f  Do  Remove  *) 


<•  Main  body  o4  SUBARECORD  •> 

ieaaaaaaaaaaaeaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 


BEGIN 

<a*I-*) 

NUMREC:-SPECS2[-1 3:  (•  Initialize  parameter*  •) 

WIDTH:-SPECS2C03; 

WRITELN (CHR (12) , ’  ’ ; 24, CHR ( 15) , ’  REMOVE  RECORD  ROUTINE  ’, 

CHR (14)); 

G0T0XY(0,3) i 

WRITELN ( ’Sel ect  desired  option:’); 

WRITELN (’  I  -  Proceed  with  REMOVE’); 

WRITELNC  2  -  Exit  REMOVE  RECORD’); 

BET0PTI0N(0PT1 ) ; 

WHILE  (OPTlO’l’)  AND  <0PT1<>’2’>  DO 
GETOPTION(OPTl) ; 

ERASE (5,3) ; 

IF  (OPTl«’l')  AND  (NUMREOO)  THEN  (*  Proceed  to  Remove  a) 

BEGIN 

60T0XY(0,5); 

WRITELN (’Enter  index  of  record  to  be  removed:  ’, 

' (1  -  ’.NUMREC,')’); 

WRITELN (CHR (7) ,CHR(13>  > ; 

RESET (INPUT); 

READ (INDEX); 


WHILE  <I0RESULT-I4)  OR  (INDEX<1)  OR 


BAD INDEX 


( INDEX >NUMREC)  DO 


ERASE  <5,4> ; 

viemrecord; 

GOTOXV(0, 14) ; 

WRI TELN ( ’ Sel ec t  d»cir»d  option:’); 
MRITELNC  1  -  Proceed  with  REMDv'E’); 

WRITELNC  2  -  Cancel  the  REMOVE’)  I 

GETOFTION (0PT2) ; 

WHILE  (OFTOO’l’)  AND  (DPT2<>’2’)  DO 
GETOPTION(OPT2) ; 

IF  (OPT2=’r)  THEN 
DOREMOVE; 

END;  <•  End  oF  Proceed  to  Remove  •) 

(*»I+*) 

END;  («  End  o-f  BUB  A  RECORD  •) 


PROCEDURE  ADDARECORD; 

<*  *) 

<*  Thie  procedure  edds  one  record  to  •  File  at  the  *) 

<*  end,  a  there  is  room,  and  updates  NUMREC;  *) 

<•  the  Number  O'#  Records  counter  stored  in  *) 

<*  SPECS2C-n.  *> 

<*  ♦> 

VAR 

INDEX,  (*  Iteration  counter  *) 

NUMREC,  (*  Number  o#  records  *) 

ROOM,  <•  Available  room  e) 

ROW,  (•  Row  on  screen  a) 

WIDTH:  (a  Number  o#  'fields  a) 

INTEGER; 

VALUE:  (a  Value  input  by  user  a) 

real; 

OPTl,  (a  Menu  options  a) 

0PT2: 

CHAR; 


DONE:  (a  Completion  indicator  a) 

BOOLEAN; 


(aaaaeeaeaeeeeeeeeeeeeeeeaaaeeeeeeaeaeeaaaeeeaaeeeaaeaeeeeaaaeeasee*) 
(a  Internal  Procedures  a) 
(eaaaeaaaaeeaaeeaaaeeeeeaaaaeaaeaeeeaaaeaseeeeeaeeaaaaaeeaeaeaaaaaaa) 


PROCEDURE  INPUTRECORD; 

BEGIN 

NUMREC : «NUMRECa 1 ; 

B0TDXY<5,5) ; 

WRITELN<CHR(15) , ’  RECORD  «  NUMREC,'  ',CHR(14))J 
WRI TELN; 
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WRITELNC  FIELD’ , ’NAHE’ : 14, ’MAX  WIDTH’ : 11 VALUE 7 ) ; 
WRITELN<  ’ - ’ ,  ’ - ’ :  14,  ’ - ’ :  1 1 ,  ’ - ’  :7) ; 

FDR  INDEX:*1  TO  WIDTH  DO 

ENTERVALUE (DATA, SPECBl , SPECS2, NUMREC , INDEX)  ; 

BPECS2C - 1  I : =NUMREC; 

END;  (*  End  o-f  INPUT  th®  RECORD  *) 

PROCEDURE  MAKECORRECT; 

BEGIN 

G0T0XY<0,2(5>  ; 

WRI TELN ( ’ Sel set  desired  option:’); 

WRITELNC  1  -  Change  a  value’); 

WRITELN(’  2  -  Exit  ADD  RECORD’); 

GETOPTION(OPTI) ; 

WHILE  (OPTlO’l’)  AND  (OPTl<>’2’)  DO 
GETDPTION(OPTl) ; 

ERASE (20,?) ; 

IF  <0PT1»’1’)  THEN 

CHANGEVALUE (DATA, NUMREC, WIDTH) 

ELSE 

D0NE;=TRUE; 

end;  <•  End  0+  MAKE  CORRECT! on s  *> 


(#•••«••••••••••••«•*•««•«««••««•••««««««««•••««««««•««••*•«•««««••«) 

<•  Mam  body  o^f  ADDARECORD  •) 

(aaaaeaaaaaaeeaaaaaaaeaaaaaaaaaaeaaaeaaaaaaaaaaaaaaaaa**************) 


BEGIN 

NUMREC: >SPECS2C-n;  (•  Initialize  parameters  •> 

width: ■SPECS2:oi; 
room: -maxpec-numrec; 

DONE: -FALSE; 

WRITELN<CHR<12) , ’  ’ : 26, CHR ( 15) , ’  ADD  RECORD  ROUTINE  ’, 

CHR ( 14) ) ; 

G0T0XY(0,5) ; 

IF  <R00M-0)  THEN  <•  No  room  to  add  record  *) 

BEGIN 

eOTOXY< 1,21)1 

WRITELN(CHR(15) , ’WARNING: ’ ,CHR( 14) , ’  The4ile  ’, 

'is  'full;  no  more  records  can  be  added.’); 
WRITELN<’  *: 11, ’Press  any  key  to  continue’); 
e0T0XY<0,21); 

BETOPTIONIOPTI); 

END 

ELSE 

BEGIN  (a  Room  available  to  add  •) 

WR1TELN(’ Select  desired  option:’); 

WRITELN;’  1  -  Proceed  Mith  ADD’); 

NR1TELN(’  2  -  Exit  ADD  RECORD’); 

BETOPTlONfOPTl); 

WHILE  (OPTlO’l’)  AND  (0PT1<>’2’ )  DO 
BET0PT10N<0PT1); 
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IF  <OPTl=’l’)  THEN 
INPUTRECORD 

ELSE 

D0ne:*true; 

WHILE  NOT  (DONE)  DO 
MAKECORRECT; 


END:  (•  End  O'f  Room  Available  •) 

END;  <♦  End  o-f  ADD  A  RECORD  *) 

PROCEDURE  CHGARECORD; 

(•  •) 

<*  Thi*  procedure  changes  the  contents  o4  one  record  *) 

(•  in  the  data  'file  by  overwriting  the  old  •) 

(•  contents  with  user  inputs.  •) 

<*  *) 

VAR 

I,  <•  Iteration  counter  •> 

INDEX,  (•  Record  being  changed  *) 

NUMREC,  Number  O'f  records  *> 

ROW,  <*  Row  on  screen  *) 

WIDTH;  <*  Number  o'f  fields  *> 

integer; 

VALUE:  (•  Value  as  input  by  user  •) 

real: 

OPTl,  (*  Menu  options  *) 

0PT2; 

CHAR; 

NAME:  f*  Field  name  *) 

string; 

DONE:  <•  Completion  indicator  •) 

boolean; 

<«  Internal  Procedures  *> 

PROCEDURE  BADRECORD index; 


BEGIN 

<**I-*) 

B0T0XY<1,20) ; 

WRITELN <CHR( 15) .’WARNING: ’,CHR( 14)  , 

’  Bad  index.  Enter  an  integer  *, 
’between  1  and  ’ .NUMREC, CHR ( 13) ) ; 
WRITELN(’  ’111, ’Press  any  ;<ey  to  try  again’); 
BOT0XY(O,20) ; 

BET0PT10N(0PT2) ; 

ERASE (B, IS) i 
B0T0XY(0,6) 1 


p  ir;  r 


RESET (INPUT) S 
READ (INDEX) ; 

(««I-i-«) 

END:  <*  End  o-f  BAD  RECORD  INDEX  •) 


< 


) 


PROCEDURE  BHOWCURRENT; 

BEGIN 

ERASE (5,4) ; 

GOTOXV (5,5) ; 

WR1TELN(CHR ( 15) , ’  RECORD#  *, INDEX,'  ’,CHR(14)): 
GOTOXV (0,7) ; 

MRITELNC  FIELD’ , ’NAME’ : 14, 'MAX  WIDTH’ : 1 1 ,' VALUE 7 ) ; 
WRITELN  (’  - ’ ,  ’ - ’ :  14,  ’ - ’ :  11,  ’ - ’  :7) ; 

FOR  l:=l  TO  WIDTH  DO 
BEGIN 

NAME:*SPECSlcn; 

IF  (LENGTH (NAME) >15)  THEN 
NAME: «COPY (NAME, 1,15): 

WRITELNd :4,NAME: 16, SPECS? t 11:7,’  ’17, 

OATAC INDEX, 11:6:4) ; 

END: 

END:  (♦  End  o-f  SHOW  CURRENT  data  *> 


< 


> 


PROCEDURE  CHANGEFIELDS; 

BEGIN 

GOTOXV (0,20) : 

l<«ITELN  ( ’  Bel  #ct  desired  option:’): 

WRITELN (’  1  -  Change  a  value’): 

WRITELN('  2  -  Exit  CHANGE  RECORD’): 

GET0PTI0N(0PT2) : 

WHILE  (0PT2<>’1’)  AND  <0PT2<>’2’)  DO 
GET0PTI0N(0PT2) : 

ERASE (20,3) : 

IF  <0PT2«’l’)  THEN 

CHANGEVALUE (DATA, INDEX, WIDTH) 

ELSE 

DONE: -TRUE: 

END:  (•  End  o-f  CHANGE  the  FIELDS  •) 


(•  Main  body  o-f  CHGARECORD  •) 


BEGIN 

(**!-•) 

NUMREC:-SPECS2[-1I:  (•  Initialize  paratneters  •) 

width: -6PECS2C 01 : 

DONE: -FALSE: 

WRITELN(CHR(12) , ’  ’ ;24,CHR(15) , ’  CHANGE  RECORD  ROUTINE  ’, 
CHR(14) ) : 

B0T0xy(0,5) : 
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WRITELN ( ’ Bel *ct  desired  option:’)! 

WRITELNC  1  -  Proceed  with  CHANGE’); 

WRITELNC  2  -  Exit  CHANGE  RECORD’)! 

GET0PT10N<0PT1 ) ! 

while  (DPTlO’l’)  AND  (OPT  1  O’ 2’)  DO 
GETOFTION(OPTI); 

ERASE (5,3) ! 

IF  (0PT1«’1’)  AND  (NUMREOO)  THEN  (*  Proceed  to  change  *) 

BEGIN 

BOTOXY (0,5) ! 

WRl TELN (’ Enter  record  to  change:  (1  -  ' , NUMREC , ' ) ’ ) ! 
WR1TELN(’  (0  «  Skip  change)’)! 

WRITELN! 

RESET (INPUT) ! 

READ (INDEX) ; 

WHILE  <10RESULT-14)  OR  (INDEX<0)  DR  < INDEX >NUMREC )  DO 
BADRE CORD INDEX! 

IF  (INDEXOO)  THEN  (a  Do  the  changes  *) 

BEGIN 

SHOWCURRENT! 

WHILE  NOT (DONE)  DO 
CHANGEFIELDS! 

END! 

END!  <*  End  o-f  Proceed  to  Change  •) 

(*•1+*) 

END!  <*  End  oP  CHG  A  RECORD  •) 


(**I  PSPP:SUBAFLD  *)  (*  Include  procedure  in  UNIT  *) 

(•••••••••##«•«••«••••«**•*•«••#»•#•»•••••••••«••«••••»#«•*•••*»#•••) 

<•  Initialization  part  oP  UNIT  •) 


PROCEDURE  SUBAFIELD; 


(*  *) 

<*  This  procedor*  remov'es  a  field  or  variable  from  a  *) 

<*  +11*  by  overwriting  it  with  the  last  +ield  in  •) 

(*  the  +ile  and  decrementing  WIDTH;  the  Number  *) 

<*  o+  Fields  counter  stored  in  SPECS2C01.  •) 

(*  * ) 

(a******************************************************************^ 


VAR 


I. 

(• 

Iteration  counter 

•  ) 

INDEX, 

(« 

Field  to  remove 

♦) 

NUMFTC, 

(• 

Number  o+  records 

*) 

width: 

INTEGER; 

(• 

Number  of  Fields 

*) 

OFTl  , 
0PT2: 

CHAR; 

(* 

Menu  options 

*) 

<*  Internal  Procedures  *1 


PROCEDURE  BAD index; 

BEGIN 

<*•!-*) 

B0T0XY(1,22); 

WRITE(CHR<15) , 'WARNING: ' ,CHR(I4) , '  Bad  field  number.’, 
•  Press  any  key  to  try  again,’); 

GOTOXY<0,22)  ; 

BET0PTI0N(0PT2)  ; 

ERASE (20,3) ; 

BOT0XY(O,20) ; 

RESET (INPUT) ; 

READ (INDEX) ; 

<**I+*) 

END;  (•  End  o+  BAD  INDEX  •) 


< 


) 


PROCEDURE  DOREMOVAL; 

BEGIN 

FOR  II"!  TO  NUMREC  DO 

DAT A [ I , I NDE  X  3 : -DATA! I , W I DTH  3 ; 
6PECS1 C INDEX3:-SPECSU WIDTH!; 
6PECS2  C I NDE  X  3 : -SPECS2 [WIDTH!; 
SPECS2  r  0  3 ; -W I DTH- 1 ; 

END;  (•  End  o+  DO  REMOVAL  •> 


(*  Main  body  o+  6UBAFIELD  *) 


BEGIN 
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NUMREC : -SPECS? t - n 
WIDTH:  -SFECsno: ; 


(*  Initialize  parameters  ♦) 


WRITELN<CHP ( 12) , ’  ’ :25,CHR ( 15) , ’  REMOVE  FIELD  ROUTINE 
CHF (14) ) S 
eOTOTY (0,5) ; 

WRITELN  ( ’  Bel  ect  desire(3  option:’); 

WR1TELN(’  1  -  Proceed  with  REMO^'E’): 

WRITELN (’  2  -  Exit  REMOVE  FIELD'); 

BET0PTI0N(0PT1 ) ; 

WHILE  (OPTlO’l’)  AND  (0PT1<>'2’)  DO 
GETOPTION (OPTl ) ; 

ERASE (5,3) ; 

IF  (OFTl='l’)  AND  (WIDTH>0)  THEN  (•  Proceed  to  Remove  *> 

BEGIN 

GOTOXY (0,5) ; 

WRITELN (’  «  ',CHR(15).’  FIELDS  IN  FILE  ’ , CHF ( 1 4 ) ) ; 

WRITELNC - - ’  )  1 

FOR  INDEX :=1  TO  WIDTH  DO 

WRITELN (INDEX: 2, *  ’ , SPECS  1 C INDEX  I ) ; 

GOTOXY (0, 18) ; 

WRITELN (’ Enter  Tield  to  be  removed:  <1  - 

width, ’ ) ’ ) ; 

WRITELNC  (0  -  Skip  removal)’); 

RESET (INPUT) ; 

READ (INDEX ) ; 

WHILE  (lORESULT-14)  OR  (INDEX<0)  OR  ( INDEX >WIDTH)  DO 
BAD index; 

ERASE ( 18,5) ; 

IF  (INDEXOO)  THEN 

doremoval; 

END;  <*  End  oT  Proceed  to  Remove  *) 

IF  (SPECS2C0I-0)  THEN 
BEGIN 

GOTOXY (1,22) I 

WR1TELN(CHR(15) , ’WARNING; ’ ,CHR ( 14) , ’  File  is 

’now  empty.  Press  eny  key  to  continue.’); 
GOTOXY (0,22) I 
GETOPTION <0PT2) J 

END; 

(*•1+*) 

END;  (•  End  o-f  SUB  A  FIELD  *) 


(**S+*) 

I 

UNIT  mu_d;  intrinsic  code  14; 

INTERFACE 

USES  TRANSCEND,  MAIN_UNIT,  MU_B,  MU_C; 

PROCEDURE  DISPLAYSPECS (VAR  SPECS 1 : HE ADER 1 ; VAR  SPECS? : HEADER2 > ; 

PROCEDURE  GETFlDWIDTH(VAR  SPECS?: HEADER? ; VAR  INDEX, ROW, 

COLS: INTEGER) ; 

PROCEDURE  GETFLDNAHE (VAR  SPECS 1 : HEADER  1 ; VAR  SPECS? : HEADER? : 

INDEX, row: INTEGER) ; 

PROCEDURE  ADDAFIELD (VAR  DATA: RAWDATA; VAR  SPECS  1 : HEADER 1 ; 

VAR  SPECS?: HEADER?) ; 

PROCEDURE  CHGAFIELDIVAR  DATA: RAWDATA! VAR  SPECS 1 : HEADER  1 j 
VAR  SPECS?: HEADER?) ! 

PROCEDURE  FILLFIELDCVAR  DATA: RAWDATA; VAR  SPECS 1 : HE ADER 1 ! 

VAR  SPECS?: HEADER?; INDEX: INTEGER) ! 

PROCEDURE  MODI  FILE (VAR  DATA: RAWDATA; VAR  SPECS 1 : HEADER 1 ; 

VAR  SPECS?: HEADER?) ; 

PROCEDURE  USERINPUT (VAR  DATA: RAWDATA! VAR  SPECS 1 1  HEADER 1 ; 

VAR  SPECS? : HEADER? 1  I NDE X : I NTEGER ) ; 

IMPLEMENTATION 


<♦  Main  body  oF  MU  D  •> 

PROCEDURE  DISPLAYSPECS; 

VAR 

I,  (*  Iteration  counter  *> 

WIDTH:  <•  Number  oi  Fields  *) 

INTEGER; 


BEGIN 

WIDTH; »SPECS?CO]; 

G0T0XY(0,7> ; 

FOR  l:«l  TO  WIDTH  DO 

WRITELN(  I:7,BPECS?CI3:  1?, '  '  ;7,SPECS1  CI3,CHR(2'?)  )  ; 
END;  <*  End  of  DISPLAY  SPECS  *) 

PROCEDURE  BETFLDWIDTH; 


BEGIN 

(*«!-•) 

B0T0XY<fi0,5)  I 

WRITE <CHR( 15) , COLS: 3, CHR ( 14) )  I 
BOTOXY(7&,5)  ; 

WRITE (CHR (15) , (BO-COLB) : 3, CHR ( 1 4 > ) ; 


BOTOXY ( 16, ROW) ; 

WRITELN  (CHR  (Z'S)  )  i 
BDTDXVdB.ROW)  ; 

REBET (INPUT) ; 

READ (SFECS2C INDEX!) ; 

WHILE  ( 10RESUL7=14)  OR  (SPECSDt  I NDE  X  !•' B)  OR 

(SPECS2C 1NDEX!>15>  OR  (COLS  +  SPECS2 C INDEX  3 >80 )  DO 
BEGIN 

BOTOXY (16, ROW) ; 

WRITELN(CHR(7) ,CHR(29) ) ; 

BOTOXY (56, ROW) ;  (•  Error  Messages  *) 

IF  <SFECS2C INDEX3<S)  THEN 

WRITE(CHR(15) , ’Must  be  at  least  B’,CHR(14)); 

IF  <SPECS2C 1NDEX3>15)  OR  (C0LS+SPECS2C INDEX  I >80 )  THEN 
BEGIN 

IF  (BPECSOC INDEX! ^15)  AND 

<CDLS*SPECB2C INDEX!>BO)  THEN 

BEGIN 

IF  (B0-C0LB<15)  THEN 

WRITE (CHR ( 15) ,’ Must  be  no  more  ’, 
’than  ’ , SO-COLS, CHR ( 14) ) 

ELSE 

WRITE(CHR(15) , ’Must  be  no  more  ’, 
’than  15’,CHB(14)) 

END 

ELSE 

BEGIN 

IF  <SPECS2CINDEX!>15)  THEN 

WRITE (CHR ( 15) , ’Must  be  no  more  ’, 
'than  15’ ,CHR(14) ) 

ELSE 

WRITE (CHR ( 15) , ’Must  be  no  more  ’, 
’than  ’ ,B0-CDLS,CHR(14) ) 

END 

END;  <*  End  o-f  Error  Messages  *> 

BOTOXY ( IB, ROW) ; 

RESET (INPUT) ; 

READ (SPECS2 1  INDEX!); 

END;  (•  End  of  Bad  Width  •) 

COLS :  ■C0LE*BPECS2 C  I NDEX  3 ,’ 

BOTOXY (60,5) ; 

WRITE (CHR (15) , COLS: 3, CHR ( 14) ) ; 

BOTOXY (76,5) ; 

WRITE (CHR ( 15) , <B0-C0L5) : 3. CHR ( 14) ) ; 

(#•!+*) 

END;  (*  End  of  GET  FIELD  WIDTH  *) 


PROCEDURE  BETFLDNAME; 

BEGIN 

<*«I-*) 

BOTOXY (26, ROW)  ; 
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t. 


WRITE (CHR  '29)  ) 5 
RESET (INPUT) ; 

READ^N<SPECSltINDEx:) ; 

IP  (LENGTH (SPECSl t INDEX ]) >SPECS2[ INDEX  3 )  THEN 

while  (LENGTH (SPECSICINDEX 3 ) >SPECS2C INDEX])  AND 
(Pose  ’.SPECSltlNDEX])*!)  DO 
delete (SPECSl C INDEX  3, 1,1); 

IF  (LENGTH (SPECS! C INDEX!) >SPECS2C 1NDEX3 )  THEN 

SPECS 1 C I NDE X  3 : =COPY ( SPECS! C I NDE  X  3 , 1 , SPECS2 C I NDE X  3 )  ! 

(**I+*) 

END;  (*  End  o-f  GET  FIELD  NAME  *) 


PROCEDURE  ADDAPIELD; 


This  procedure  adds  a  -field  or  variable  to  a  data 
file,  if  there  is  room,  which  is  then  filled 
with  either  computed  values  or  user  input 
values.  The  Number  of  Fields  counter,  WIDTH, 
which  is  stored  in  SPECS2t03,  is  updated. 


Internal  Procedurt 


PROCEDURE  DEFINEFIELD; 

BEGIN 

width: -8PECG2C 03; 

C0LS:-0; 

FOR  l;-l  TO  width  do 

COLS :  -C0LS-^SPECS2C  I  3 ; 


e0T0XV(0,5>  I 

WRITELNICHR (15) , 'FIELD  NUMBER’ , ’WIDTH’ ;9, ’NAME’ : 8, 
CHR (14)); 


S0T0XY<50,5)  i 


COLS  LSrT 


WRITELN(CHP ( 15) , *COLS  USED: ' , COLS: 3, ’ 

(BO-COLS' :3,CHR(14' ) ; 

DIBPLAYSPECS(SFECS1,SPECS2) ; 

BOTOXV (0, 19) ; 

WRITELN(’Now  enter  Midth  and  name  For  the 

’added  -field.  The  width  must  be  at  ’); 

WRITELN < ’ 1  east  6  and  no  more  than  15.  This 

’includes  room  for  6  significant  digits.'); 
WRITELN (’The  name  should  be  no  wider  than 

’the  field.  Finally,  remember  the’), 

WRI TELN (’ upper  limit  of  80  characters 
’ per  record .’) ; 

INDEX :  =WIDTH-»  1 1  (*  New  field  specs  •») 

ROW:  =lNDEX-r6; 

GOTOXY (0, ROW' ; 

WRITE (INDEX;?) ; 

BETFlDW1DTH(SPECS2, index, ROW, COLS) ; 

GETFlDNAME (SPECSl ,SPECS2, INDEX, ROW) ; 

ERASE ( 19,4) ; 

GOTOXY (0, 19) ; 

WRITELN (’ Sel ect  desired  option;’); 

WRITELNC  I  -  Change  specifications’); 

WRITELNC  2  -  Proceed  with  ADD’); 

WRITELN; 

BETOPTION(OPTI)  ; 

WHILE  (OPTlO’l’)  AND  (OPTlO’2’)  DO 
GETOPTION(OPTl) ; 

ERASE (19, 3) ; 

end;  <*  End  of  DEFINE  the  FIELD  *) 


<*  Main  body  of  ADDAFIELD  *> 


BEGIN 

NUMREC; ■SPECS2C -1 3 ;  (*  Initialize  parameters  *) 

width: -SPECS2C03; 

room;-maxsize-width; 

DONE: -FALSE; 

WRITELN (CHR( 12),’  ’ : 30, CMR ( 15) , ’  ADD  FIELD  ROUTINE  ’, 

CHR(14) ) ; 

G0T0XY(0,5)  1 

IF  (R00M-0>  THEN  (*  No  room  to  add  a  field  */ 

BEGIN 

GOTOXY (1,21) I 

WRITELN(CHR(15), ’WARNING:’, CHR(14),’  The  file  ’, 

’is  full.  No  more  fields  can  be  added.’); 
WRITELN(’  ’Ill, ’Press  any  key  to  continue’); 

GOTOXY (0, 21 ) ; 

BET0PTI0N(0PT1> J 

END 

ELSE 

BEGIN  <•  Room  available  to  add  field  «> 
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WRITELN ( ’ Sel ect  desired  option;’); 

WR1TELN<’  1  -  Proceed  with  ADD’); 

WR1TEUN(’  2  -  Exit  ADD  FIELD’); 

GETOPTIOM<OFTi); 

WHILE  (OPTlO'l’)  AND  (0FTl<>’2’)  DO 
GET0FTI0N(0PT1 ) ; 

ERASE (5,3) ; 

IF  (0FT1=’2’)  THEN 
DONE:=TRUE; 

WHILE  (OPT)=’l’)  DO 
DEFINEFIElD; 

IF  NOT  (DONE)  THEN  (•  Fill  the  -field  *) 

BEGIN 

SPECS2C03:«=1NDEX;  (•  New  WIDTH  *) 

FOR  1:=1  TO  NUMREC  DO 
DATACl, INDEXD:=0.0; 

FILLFIELD (DATA, SPECS!, BFECS2,  INDEX)  ; 

END! 


END;  (*  End  o-f  Room  Available  •> 
END;  (•  End  o-f  ADD  A  FIELD  •) 


<*• 

»• ) 

PROCEDURE  CHGAFIELD; 

(** 

(* 

»*) 

*) 

<• 

This  procedure  changes 

both 

the  spec  i-fi  cat  ions  -for 

a) 

<* 

and  contents 

o-f  one  data  -field.  A  check  is 

*> 

<* 

made  to  keep 

each 

record  under  Bi  columns. 

*> 

<* 

•  ) 

<** 

»«•«« 

VAR 

COLS, 

<* 

Number  o-f  columns  per  record 

•  ) 

1. 

<♦ 

Iteration  counter 

•  ) 

INDEX, 

(* 

Field  to  be  changed 

•  ) 

NUMREC, 

(• 

Number  of  records  in  file 

*) 

ROW, 

<* 

Row  on  screen 

*) 

width: 

<* 

Number  of  fields  in  file 

*) 

integer; 

OPTl, 

0PT2, 

(• 

Menu  options 

•  ) 

0PT3: 

CHAR; 

DONE: 

<• 

Completion  Indicator 

*) 

boolean: 

<•* 

»*) 

(• 

Internal 

procedures 

*> 

(*• 

»«»«« 

**) 

PROCEDURE  PICKOPTIDNJ 
BEGIN 
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WRITELN(CHR(12) , ’  ’ : 25, CHR ( 15) , ’  CHAN5E  FIELD  ROUTINE 
CHR ( 1 4 ) ) 1 
BOTOXY (0,5)  1 

WR I TELN < ’ Thi s  routine  will  allow  you  to  chance  the  ’, 
’contents  o-f  a  currently  de-f  i  ned  and’); 

WRITELN  ( ’  <  ul  1  ■field  in  the  data  array.  Once  stanted  ’, 
’that  -field  may  become  contaminated.’); 
EOTOXYfO, 10) ; 

WRITELN ( ’ Sel ect  desired  option:’); 

WRITELNC  1  -  Proceed  with  CHANGE’); 

WRITElNi’  2  -  Exit  CHANGE  FIELD’); 

END; 


(••••••«••••«»««••«••••««••••••••«•••*»•••••••••«••••**•«•«**•*«•••«) 

PROCEDURE  CHECKSPECS; 

BEGIN 

WRITELN  (CHR  ( 12)  ,  ’  ’  1  25,  CHR  ( 1 5)  ,  ’  CURRENT  F1E..D  ’, 
’SPECIFICATIONS  ’,CHR(14>>; 

BOTOXY (0,5) ; 

WRITELN(CHR( 15) , ’FIELD  NUMBER’ , ’WIDTH’ :9, 

’NAME’ :B,CHR(14)); 

B0T0XY(50,5)  ; 

WRITELN (CHR (15), ’COLS  USED: ’, COLS: 3, ’  COLS  LEFT:’, 
(BO-COLS) :3, CHR (14) ) ; 

DISPLAYSPECS<SPECS1,SPECS2) ; 

BOTOXY (0, 19) ; 

WRITELN (’Sel ect  desired  option:’); 

WRITELN(’  I  -  Proceed  with  CHANGE’); 

WRITELN(’  2  -  Exit  CHANGE  FIELD’); 

end;  <*  End  o-f  CHECK  SPECi-f icationS  *) 


< 


) 


PROCEDURE  MAKECHANBE; 

BEGIN 

ERASE (18, 5) ; 

BOTOXY (0,20) ; 

WRITELN(’Now  enter  new  WIDTH  and  NAME  for  FIELD  #  ’, 
INDEX) ; 

row: >18; 

cols: -C0L8-8PECB2C INDEX ] ; 

GETFLDW I DTH ( SPECS2 , 1 NDE  X , ROW , COL  S ) ; 

SETFLDNAME  <  SPECS 1 , SPECS2 , I NDE  X , ROW ) ; 

DI 6PLAYSPECS  <  SPECS 1 , 6PECS2 ) ; 

ERASE (18, 5) I 
e0T0XY(0, 19) I 

WRITELN (’Bel ect  desired  option:’); 

WRITELN(’  1  -  Change  specifications  of  field  a  ’, 

INDEX,’.’); 

WR1TELN(’  2  -  Proceed  with  CHANGE  FIELD’); 

BET0PTI0N(0PT3) f 
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WHILE  (DFT30M’)  AND  <0PT3<>’2’>  DO 
GETDPTI0N(0PT3> ; 

ERASE  < 19,3) ; 

IF  <OPT3=’2’)  THEN 
DOne:=true; 

END;  (•  End  o-f  MAKE  CHANGE  •) 


(••••**•**•••*••••••*••••••••••••««••«•••••«•••«••»•**•••««*••«**«*«) 

<*  Mam  body  o4  CHGAFIELD  *) 


BEGIN 

(•«!-«) 

NUMREC: »SPECS2C -1 1 ;  (*  Initialize  parameters  *) 

width:«specs2C01; 

DOne:<«false; 
cols: «o; 

pickoption; 

BETOPTION (OPTl ) ; 

WHILE  (OPTIOMM  AND  <0PT1<>’2’)  DO 
GETOPTION(OPTl) ; 

ERASE (S,8) : 

IF  <0PT1«’1’)  THEN  (•  Do  a  Change  *) 

BEGIN 

FOR  i:«i  TO  width  do 

COLS:  =C0LS-*SPECS2C  I  3 ; 

CHECKSPECS? 

BETOPTION <0PT2) ; 

WHILE  <0PT2<>'1’)  AND  (0PT2<>’2’)  DO 
GET0PTI0N<0PT2) S 
ERASE (IB, 5>; 

IF  <0PT2»'’l’)  THEN  (*  Accomplish  change  a) 

BEGIN 

G0T0XY<O,2O'  ; 

WRITELNi’Erter  Field  to  be  changed: 

' <I  to  ’ .WIDTH, ' ) ’ ) ; 

WRITELNi’  <0  ■  Skip  change) ; 

G0T0XY(6, IB) ; 

RESET (INPUT) ; 

READ < INDEX ) ; 
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G0T0XY(6, 18) ! 

RESET (INPUT)  ; 

READ(INDEX)  ; 

END;  (*  End  d4  Bad  Index  *) 

WHILE  NOT (DONE)  DO 
MAKECHANGE; 

FILLFIELD(DATA,SPECS1,SPECS2, INDEX) ; 

END;  <•  End  o-f  Accomplish  Change  ♦) 

END;  (•  End  o-f  Do  a  Change  *) 

(••I+«) 

end;  (•  End  o-f  CHG  A  FIELD  •) 


PROCEDURE  FILLFIELD; 

(•«•••«««•••••••»•«•«•«••*•••»•«••«*••••»•••««••••••»••«•••••««•««««) 

(«  • ) 

(«  This  procedure  displays  the  menu  oT  the  options  •) 

(•  available  For  Filling  the  speciFied  Field  •) 

(*  in  procedures  ADDAPIELD  and  CHGAFIELD,  It  *> 

(•  then  calls  the  appropriate  procedure.  •) 

(a  *) 

(••••••*••*•••••••••••««••*••»•«•«•••«•••«••»•«««•«#•«•«••*••••••««•) 

VAR 

I,  <*  Iteration  counter  •) 

NUMREC:  (*  Number  oF  records  *) 

INTEGER; 

OPT:  <*  Menu  option  a) 

CHAR; 

DONE:  <*  Completion  indicator  a) 

BOOLEAN; 

(aaa*aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa*a) 
<a  Internal  Procedure  a) 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

PROCEDURE  DEFINEOPTS; 

VAR  OPT:  CHAR;  (a  End  oF  display  indicator  a) 


BEGIN 

WRITELN(CHR(12),’  ' : 26, CHR ( 15> , ’  FILL  FIELD  OPTIONS 
CHR(14) ) 1 
B0T0XY(0,5) 1 
WRITELN(’Option’ )| 


WRITELNC - '  )  ; 

WRITELN(’  1  -  Fills  speciFied  Field  with  user 
'selected  constants;  based’); 

WRITELNC  on  partition(s)  within  that  or  a  ’ , 

'diFFerent  Field. ' ,CHR(13> > I 

WRITELNC  2  -  Computes  and  stores  in  the  speciFied 
'Field  the  results  oF  one  or  more’); 

WRITELN(’  arithmetic  operations  on  one  or  more  ’, 

'Fields. ’,CHR(13))1 

MR1TELN(’  3  -  Accepts  data  as  input  by  the  user  at  ’, 
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’the  keyboard;  one  record  at  a  t i me. ’ , CHB ( 13) > ; 
WRITELNC’  4  -  Display  these  de'f  i  ni  1 1  ons’ i  CHR  ( 1  3)  >  ; 
WRITELNC  5  -  Exit  PILL  FIELD  routine’)! 

BOTOXY (22,22) ! 

WRlTE(’PresE  any  key  to  continue  ’)» 

GETOPTION(OPT) ! 

END;  (♦  End  o4  DEFINE  OPTS  *) 


(*  Main  body  o4  FILlFIELD  *) 

(••••*••••••«••**•••*•••««••«*•••••••••••«•••••*••«••••*•••«••**»«*•) 

BEGIN 

(**R  MU_B  *)  t*  Retain  UNIT  in  memory  *) 


DDNE:=FALSE! 

NUMREC : -SPECS2  C - U ! 

WHILE  NOT (DONE)  DO 
BEGIN 

WRITELN(CHR(12) , ’  ’ : 26, CHR ( 15) , ’  FILL  FIELD 
•  ROUT  I NE  ’ , CHR (14))! 

BOTOXY (0,5) ; 

WRl TELN ( ’ Sel ect  desired  opti on: ’ , CHR ( 13) ) ! 

WRITELNC  1  -  Recode’  >  ! 

WRITELNC  2  -  Compute’)! 

WRITELN(’  3  -  User  input’)! 

WR1TELN(’  4  -  De-fine  above  options’); 

WRITELNC  5  -  Exit  FILL  FIELD’)! 

BETOPTION(OPT) ; 

WHILE  <0PT<’1’)  AND  <DPT>’5’)  DO 
BET  OPT  I  ON  (OPT)  ; 

CASE  (OPT)  OF 

•  1  ’  :  RECODE (DATA, BPECSl , SPECS2, INDEX > ; 

’2’  :  C0MPUTE(DATA,SPECS1,BPECS2, INDEX) ; 

•3’ :  USERINPUT (DATA, BPECSl, BPECS2, INDEX)  ! 

*4’;  DEFINEOPTS! 

’5’:  FOR  i:«l  TO  NUMREC  DO 

IF  (DATAt  I,  INDEX  300.0)  THEN 
done: -TRUE; 

END!  <♦  End  o-f  CASE  *) 

IF  <0PT»’5’)  AND  NOT (DONE)  THEN 
BEGIN 

BOTOXY (O, IB) ! 

WRITELN(CHB(15) ,’  WARNING; ’ ,CHR(14) , 

’  Field  is  currently  all  *ero’’B’)! 
WRITELN! 

WRITELN(’  ’;ll,’BeIect  desired  option!’)! 
WRITELN(’  1  -  Go  back  and  ’, 

’•fill  -field’)! 

WRITEC  2  -  Leave  field  ’, 

’all  *ero”s  ’)! 

SETOPTION(OPT) f 

WHILE  (OPTO’l’)  AND  (OPTO’ 2’)  DO 
BET0PT1DN<DPT) ! 

IF  (OPT-’ 2’)  THEN 
DONE: -TRUE! 

END!  (•  End  of  error  exit  attempt  •) 


PROCEDURE  MODI  FILE 


(*  ♦) 

(•  This  procedure  needs  as  input:  •) 
(*  •) 
<«  DATA  -  Array  o-f  raw  data  to  be  modified  *) 
<*  SPECSl  -  Array  ot  Field  or  variable  names  *) 
t*  SPECS2  -  Array  oF  Field  widths  *) 
<*  * ) 
<•  This  procedure  returns  as  output  the  above  arrays  *) 
(*  aFter  modi F 1  cat 1  on.  Changes  include  addition,  *) 
<•  removal,  and  modiFication  oF  both  records  and  *> 
<*  Fields.  *> 
(*  *) 


VAR 

DONE:  (*  Completion  indicator  *) 


boolean; 

OPT:  (*  Menu  option  a) 

CHAR; 

<*  Internal  Procedures  •> 


PROCEDURE  displaywarning; 

BEGIN 

WRITELN(CHR(12),'  ' : 25, CHR < 1 5) , ’  MODIFY  DATA  ROUTINE 
CHR(14))5 
G0T0XY(0,5) ; 

NRITELN<CHR<15) , ’  WARNING: CHR ( M ), ’  You  Should 
'save  all  data  changes  as  soon  as’>( 

WRITELNC  possible  or  risk  losing  them.’); 

GOTOXY  <0, 10) ; 

WRITELN<*  NOTE:  IF  you  save  the  modiFied  data 
’using  the  same  name  as  beFore,’); 

WRITELN;’  you  will  overwrite  the 

’ unmodi Fied  data.’); 

GOTOXY <22, 22) ; 

WRlTEC’Press  any  key  to  continue  ’); 

GETOPTION(OPT) ; 

END;  (•  End  oF  DISPLAYWARNING  «) 


( 


) 


PROCEDURE  DISPLAYMENU; 

BEGIN 

WRITELN(CHR(12),’  ’ 1 25, CHR < 15) , ’  MODIFY  DATA  ROUTINE  ’, 
CHR(14)); 

GOTOXY (0,5); 

WR I TELN( ’Select  desired  option:’); 

WRITELN(’  1  -  Add  a  record’); 

WRITELN<’  2  -  Delete  a  record’); 

WRITELN(’  5  -  Add  a  Field’); 

WRITELN(’  4  -  Delete  a  Field’); 


WR1TELN(’  5  -  Change  a  record’); 

WR1TE1_N(’  <>  -  Change  a  -field’); 

WRITELNC  7  -  Exit  MODIFY  DATA  routine’); 

GET0PT10N<0PT) ; 

while  (oft<’i’)  or  (0pt>’7’>  do 

BETOFTION (OPT ) ; 

CASE  'OPT)  OF 

•  1’ :  addareoord(Data,specsi, SPECS?' ; 

•2’  :  SUBARECORD (DATA, SPEC51, SPECS?) ; 

■3’ :  ADDAFIELD (DATA, SPECBl, SPECS?) ; 

’4  :  SUBAFIELD (DATA, SPECS!, SPECS?) ; 

•5’  :  CHGARECORD (DATA, SPECS!, SPECS?) ; 

•<>’  :  CHGAFIELD  (DATA,  SPECS!,  SPECS?)  ; 

’7’:  done:»true; 

END;  (*  End  of  CASE  *) 
end;  (*  End  of  DISPLAY  MENU  *) 


(«  Main  body  of  MODIFILE  *) 


BEGIN 

DONE; -FALSE; 
while  not (DONE)  DO 
DISPLAYMENU; 
DISPLAYWARNING; 

END;  <*  End  of  MODIfy  FILE  *) 


BDTCXY  (0,20  ; 

GETOFTION  <0PT2) ; 

ERASE (20, 1 ) ; 

BOTOXY (50, B> ; 

RESET (INPUT) ; 

READ (VALUE) ; 

END!  (*  EntJ  o-f  Bad  Value  •) 

DATAri, indexi:=value; 

ERASE (8, 1 ) ; 

(*«!+*) 

END;  (*  End  o-f  TAKE  INPUTS  *) 


(*  Main  body  o-f  USER  INPUT  *) 


BEGIN 

NUMREC :  =SPECS2C -1  I !  <*  Initialize  para(neters  *) 

name:=specsi c index]; 

IF  (LENGTH(NAME) >15)  THEN  (•  Truncate  to  +it  •) 

NAME :=COPY( NAME, 1,15); 

F1ELDWIDTH;=SPECS2C INDEX]; 

WRITELN (CHR ( 12) , ’  ’ : 26, CHR ( 15) , '  USER  INPUT  ROUTINE 
CHR (14)); 

G0T0XY(0,5) ; 

WRITELNCAny  values  input  that  exceed  the  MAX  WIDTH 
'will  mess  up  the  columns  in  the’); 

WRl TELN ( ’ ECHOr I LE  routine.  To  prevent,  run  ’’Change  ’, 

’a  ♦ield’’  to  expand  the  Field  width’); 

WRITELN (’ alter  entering  all  records,  then  exit  ’, 

’FILLFIElD  without  changing  Field  contents.’); 

GO'^OXY  (0,  10)  ; 

WRI TELN (’ Bel ect  desired  option:’); 

WRITELN(’  1  -  Proceed  with  INPUT’); 

WRITELN!’  2  -  Exit  USER  INPUT’); 

GETOPTION (OPTl )  ; 

WHILE  (OPTlO’l’)  AND  <0PT1<>’2’)  DO 
GETOPTION (OPTl); 

IF  <OPTl«’l’)  THEN  (•  Start  inputting  ♦) 

BEGIN 

DISPLAYHEADING; 

FOR  l:«l  TO  NUMREC  DO 
TAKE INPUTS; 

END;  (*  End  oF  Start  Inputting  *) 


END; 


<•  End  oF  USER  INPUT  a) 


<**S+*) 


UNIT  mu_e;  intrinsic  code  15; 

INTERFACE 

USES  t1AIN_UNIT; 

PROCEDURE  LOADDATA<VAR  DATA: RAWDATA; VAR  SPECS  1  ;  HEADER 1  ; 
VAR  SPECS2: HEADER!) ; 

PROCEDURE  SAVER ILE (VAR  DATA; RAWDATA; VAR  SPECS  1  :  HEADER  1  ; 
VAR  SPECS!: HEADER!)  ; 

PROCEDURE  ECHOFILE(VAR  DATA: RAWDATA; VAR  BPECSl  :  HEADER  1  ; 

VAR  SPECS2:HEADER2;PRINTER:B00LEAN)  ; 


IMPLEMENTATION 


(••••«*•••<««•••••«*«•««••••««•««•«•«••«••««««••««««««««*««*•««»••»•) 

<*  Mam  part  o-f  MU_E  *) 


PROCEDURE  LOADDATA; 


(* 

*) 

(* 

Thi  « 

procedure  requires  existence  of  data  +iles 

♦  ) 

(* 

saved  via  the  SAVEFILE  procedure 

•  ) 

<♦ 

*> 

(• 

Th  1  s 

procedure  returns  as  output: 

*) 

(• 

*) 

(« 

DATA  -  Array  o-f  raw  data  as  stored  on  disk 

*) 

<• 

BPECSl  -  Array  of  field  names 

♦  > 

(• 

6PECS2  -  Array  of  field  widths 

•  ) 

(• 

*> 

VAR 


I,  J. 

(* 

Indexes 

*) 

NUMREC, 

<* 

Number  of 

records  in  tile 

*) 

width; 

INTEGER; 

(• 

Number  of 

fields  in  file 

*) 

FILEID, 

<* 

File  name 

as  input  by  user 

*) 

FILENAME: 

BTRINGC21 3; 

<* 

File  name 

as  stored 

♦  ) 

OPTl  , 

0PT2: 

CHAR; 

(* 

Menu  options 

•  ) 

<•  Internal  Procedures  •) 


PROCEDURE  FILEFOUND; 

BEGIN 

BOTOXY (0, 15) ; 

WRITELNC Loading  ’.FILEID, .  .Pleaae  atand  by') I 


RE ADEN (DATAFILE, SPECB2  C - 1 D , BPECS2  C  0  3); 


NUMREC : «BPECE2C - 1 3 ; 
wiDTN:=sPEcsrro3; 

FOR  l:=0  TO  width  do 

RE ADLN (DATAFILE, SPECS U 13); 

FDR  I:=l  TO  WIDTH  DO 

READLN (DATAFILE, SPECS2C 13) ; 

FOR  l:*=l  TO  NUMREC  DO 

FOR  j:=i  to  width  DO 

readln(datafile,data[1, j3) : 

GOTOXY  ((3,17); 

WRlTE(’Load  complete.  Press  any  key  to  continue  ’); 
BETOPTION (0PT2) ; 

WRITELN (CHR ( 12) ) ;  (*  Clear  screen  *) 

OPTI : =  2’ ; 

END;  <*  End  o-f  FILE  FOUND  •) 


( 


) 


PROCEDURE  FILENOTFOUND; 

BEGIN 

GOTOXY (0, 15) ; 

WRITELN  (’Sped -fled  -file  not  Found’ ,  CHR  ( 13)  >  I 
WRITELN (’ Bel ect  desired  option:’); 

WR1TELN(’  1  -  Try  another  load’); 

WRITELN (’  2  -  Exit  LOAD  Procedure’); 

GETOPTION (OPTI ) ; 

WHILE  (OPTlO’l’)  AND  <0PTl<>’2’)  DO 
GETOPTION (OPTI) ; 

ERASE (1 2, B) ; 

G0T0XV<0, 12) ; 

end;  <*  End  oF  FILE  NOT  FOUND  *) 


<*  Main  body  oF  LOAD  DATA  •) 


BEGIN 

(*•!-*) 

WRITELN (CHR ( 12) , ’  ’ : 26, CHR ( 15) , ’  LOAD  DATA  ROUTINE 
CHR (14)); 

G0T0XY<0,5) ; 

WRl TELN ( ’ Gel ect  desired  option:’); 

WRITELN (•  1  -  Load  a  data  File’); 

WR1TELN(’  2  -  Exit  LOAD  routine’): 

BETOPTION (OPTI) ; 

WHILE  (OPTlO’l’)  AND  <0PT1<>’2’)  DO 
GETOPTION (OPTI ) ; 

WHILE  (0PT1»’1’)  DO  <*  Attempt  a 

BEGIN 

GOTOXY (0, 10) ; 

WRITELN (’ Enter  desired  File  name: 

’(1  to  10  characters)’); 

GOT0XY(0, 12) ; 

RESET (INPUT); 

READLN(FILEID>; 


load 


*) 
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IF  (LENGTH (FILEID >10)  THEN 

F1LEID:=CDFY(FILE1D, 1,10); 

FILENAME: =C0NC AT (’BLANK: ’ , FI LE I D , ’ . TE X T ’ ) ( 

RESET (DATAFILE, FILENAME) ; 

IF  (I0RESULT=0)  THEN  (*  File  ^ound  *) 

FILEFOUND 

ELSE 

FlLENOTFOUND: 

CLOSE (DATAFILE)  ; 

END;  (*  End  o^f  Attempt  load  *> 

(**]♦*) 

END;  (•  End  o-f  LOADDATA  «) 


PROCEDURE  SAVEFIlE; 

(*  * ) 

(*  This  procedure  needs  as  input:  *) 

(*  *) 

(*  DATA  -  Array  oF'data  to  be  saved  *) 

(*  SPECSl  -  Array  o4  -field  names  *) 

(*  BPECS2  -  Array  of  field  widths  *) 

(*  a) 

(•  This  procedure  stores  the  data  file  on  disk  a> 

(*  under  the  name  BLANK: <name>. TEXT  a) 

(a  a) 

(aaaaaaaacaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

VAR 

1 ,  '  ,  <a  Indexes  a) 

NUMREC,  (a  Number  of  records  in  file  a) 

width:  (a  Number  of  fields  in  file  a) 

integer; 

FILEID,  (a  File  name  as  input  by  user  a) 

FILENAME:  (a  File  name  as  stored  a) 

STRINGC21 D; 

OPTl,  (a  Menu  options  a) 

0PT2: 

char; 

(aaaaaaaaaaaaaaaaaaaaaeaaaaaaaaaaaaaaeaaaaaaaaaaaaaaaaaaaaaaaaaaaa**) 
(a  Internal  procedure  a) 

(aaaaaaaaaaaaaaaeeaaaaaaaaaaaaaaaaaeeaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 


PROCEDURE  BADSAVEf 
BEGIN 

B0T0XY(0, 15) ; 

WRITELN (CHR (7) , 'Save  not  possible.  Make  sure  a 
'properly  formatted  disk  with’)! 

WRITELN (' enough  space  is  available  in 

'Drive  #2  and  the  filename  is  10  or'H 
WRITELN (' less  characters  starting  with  a  letter.', 
CHR ( 1 3 ) ) I 

WRITELN (' Bel ect  desired  option:' >t 


WRITELNI’  1  -  Try  another  save’); 

WRITELNC  2  -  Exit  SAVE  Pr  Dcedu”  e  ’  )  ; 

getoft:on(opti); 

WHILE  (OFTlO’l')  AND  (0PT1<>'2’>  DO 
GETOFTION (OPTl ) ; 

ERASE (10,13); 

END; 


<*  Main  body  o-f  SAVEFILE  *) 


BEGIN 

(*•!-*) 

NUMREC : «SPECS2  C - 1 3 ; 

WIDTH;=SPECS2:03; 

WR1TELN(CHR(12) , ’  ' : 24, CHR ( 15) , ’  SAVE  DATA  FILE  ROUTINE  ’, 
CHR  < 14) ) ; 

BOTOXY (0,5) ; 

WR I TELN (’ Sel ect  desired  option;’); 

WRITELNC  1  -  Save  a  data  tile’); 

WRITELNC  2  -  Exit  SAVE  routine’); 

BET0PTI0N(0PT1 )  ; 

WHILE  (OPTlO’l*)  AND  (DPT1<>’2’)  DO 
BETDPTION(OPTl); 


while  (OPTl*’!’)  DO  <*  Attempt  a  save  *) 

BE(3IN 

BOT0XY(O, 10) ; 

WR  I  TELN  (’ Enter  desired  tile  name’. 

’<1  to  10  characters)’); 

BOTOXY (0,12); 

RESET (INPUT) ; 

READLN(FILEID) ) 

IF  (LENGTH(FILEID> >10)  THEN 

fileid:-copy(fileid, 1, lO) ; 
filename;«concat(’Blank: ’ ,fileid, ’ .text’ ) ; 

REWRITE (DATAFILE, FILENAME) ; 

IF  (I0RESULT*0)  THEN  (*  File  properly  opened  ♦) 

BEGIN 

BOTOXY (0, 15) ; 

WRl TELN (’Saving  ’.FILEID,’.  .  .’, 

’Please  stand  by’); 

BPECSlt03:-FILEID; 

WRITELN(DATAFILE,BPECS2t-n,  ’  ’  ,SPECS2C03)  ; 
FOR  I;-0  TO  WIDTH  DO 

WR  I  TELN  ( DAT  AF I LE ,  SPECS  1  C  U  )  J 
FOR  l:-l  TO  WIDTH  DO 

WRITELN(DATAFILE,SPECS2Cn)  ; 

FOR  l:*l  TO  NUMREC  DO 

FOR  J:-l  TO  WIDTH  DO 

WRITELN(DATAFILE,DATACI, J3) 1 

IF  (lORESULT-O)  THEN 
BEGIN 
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eOTOXYfO, 17> ; 

WRITE (’Save  complete.  Press  any 
'key  to  continue  ’)( 
GET0PTI0N(0PT2> : 

WP1TELN(CHR(12) ) 5 
0PTi:=’2‘ i 

END 

ELSE 

BADSfiVE ; 

END 

ELSE 

badsave; 


END;  <*  End  o-f  Attempt  Save  ♦) 

CLOSE (DATAFILE, LOCK) ; 

(**1+*) 

END;  <*  End  o-f  SAVEFILE  *) 

PROCEDURE  ECHOFILE; 

<*  *) 

(*  This  procedure  needs  as  input:  *> 

<♦  «) 

<*  DATA  -  Array  oF  data  to  be  printed  *> 

<*  SPECSl  -  Array  oF  Field  names  •) 

<*  BPECS2  -  Array  oF  Field  widths  a) 

(•  PRINTER  -  Bet  iF  printer  available  *) 

<*  *) 

<*  This  procedure  provides  an  echocheck  oF  data  to  ♦) 

<•  screen  and  printer  (iF  desired)  *) 

(•  *) 

(••#«••••*«•••#«••••••«•••••«••«••••••••••*•««••*«##•••*»•••*•••••••) 

VAR 

I,  <•  Iteration  counter  ♦) 

FIELDWIDTH,  <*  Augmented  width  used  by  printer  *) 

INDEX,  <*  Index  into  various  arrays  *) 

NUMREC,  <•  Number  oF  records  in  File  *) 

WIDTH:  (a  Number  oF  Fields  in  File  a) 

INTEGER; 

FIELDS:  <a  Data  Fields  to  be  echoed  «) 

VECTOR; 

OPTl,  (a  Various  menu  options  a) 

0PT2, 

0PT3: 

CHAR; 

(aaaaaaa*ae*a*aa*aa*aaaaaaaae«*a««*aaaaaa«***aaaaa»«*a«aaaa*a**»«**a) 
<a  Internal  Procedures  *) 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaeaaaaaaaaaaaaaaaaaaaaaaaeaaaaaaaaaaa**) 


PROCEDURE  DISPLAyFIELDS; 

BEGIN 

GOTOXy (0,7) I 

FOR  J:*l  TO  WIDTH  DO  (a  Display  selected  Fields  a) 


G0TOXV(0, 17) i 

WRITE (’Save  complete.  Press  any 
'key  to  continue  ’); 
BET0PTIDN<DPT2)  ; 

WRITELN (CHR i 12) ) 1 
DPTi:=’2’ 1 

END 

ELSE 

BADSAVE ; 

END 

ELSE 

badsave; 

END;  (*  End  ot  Attempt  Save  «) 

CLOSE (DATAFILE, LOCK) ; 

<*•!**) 

END;  <*  End  o-f  SAVEFILE  *) 


PROCEDURE  ECHOFILE; 


a  ♦) 


This  procedure  needs  as  input:  •) 

*) 

DATA  -  Array  o-f  data  to  be  printed  *) 

BPECSl  -  Array  o+  Field  names  *) 

SPECS2  -  Array  oF  Field  widths  a) 

PRINTER  -  Set  iF  printer  available  ♦) 

a) 

This  procedure  provides  an  echocheck  oF  data  to  *) 

•creen  and  printer  (iF  desired)  *> 


a  a) 


VAR 


(a 

Iteration  counter 

a) 

FIELDWIDTH, 

<a 

Augmented  width  used  by  printer 

a) 

INDEX, 

(a 

Index  into  various  arrays 

a) 

NUMREC, 

(a 

Number  oF  records  in  File 

a) 

width: 

INTEGER; 

(a 

Number  oF  Fields  in  File 

a) 

FIELDS: 

VECTOR; 

(a 

Data  Fields  to  be  echoed 

a) 

OPTl , 
0PT2, 
OPT3: 

(a 

Various  menu  options 

a) 

CHAR; 


(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 
(a  Internal  Procedures  a) 
(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 


PROCEDURE  DIBPLAYFIELDS; 
BEGIN 

B0T0XY<0,7) ; 


FOR  t;*!  TO  WIDTH  DO 


(a  Display  selected  Fields  a) 


IF  (FIELDStn  =  l)  THEN  (*  Set  to  1  i*  eelected  *) 

BEGIN 

WRITE (CHR (15) ,1:2,’.  ’ , SPECS 1 C I  3) ; 

GDTOXY (20, l*fc) ; 

WRITEi.N(’ON  ’,CHR<14)>: 

END 

ELSE 

BEGIN 

WRITE (1:2,’.  ’ , SPECSl t 1 3 ) ; 

GOTOXY  (20,  l-t-6)  ; 

WRITEi.N(’OFF'  )  ; 

END; 

END;  (*  End  o-f  display  fields  •) 


( 


) 


PROCEDURE  CHANGER  I  ELDS; 

(^AR  opt:  CHAR:  (*  Menu  Option  *) 

BEGIN 

(*»!-*) 

GOTOXY (0, 19) ; 

WRITELN(’Any  changes  to  above  1  i  st ,  CHR  ( 1  3 )  >  ; 

WRITELN(’  1  -  Go  with  list  as  is’); 

WR1TELN(’  2  -  Change(6>  required’); 

GETOPTION (OPT) ; 

WHILE  (ORTO’l’)  AND  (OPTO’ 2’)  DO 
GETOPTION (OPT) ; 

WHILE  (0PT=’2’)  DO  (*  Hake  changes  •) 

BEGIN 

ERASE(19,4) ; 

G0T0XY(0, 19)  ; 

WRITELNC  Enter  -field  nuntber  to  change’ ,  CHR  ( 13)  )  ; 
RESET ( 1 NPUT )  ; 

READ ( INDEX)  ; 

IF  (I0RESULT»14)  OR  (INDEXED  DR 

<INDEX>WIDTH)  THEN 

BEGIN 

GOTOXY (1,22) ; 

WR1TELN(CHB( 15) , ’WARNING: ’ ,CHR( 14) , 

’  Bad  field  designator.  Press 
'any  key  to  try  again. ’>( 

GDTOXY (0,22) J 

END 

ELSE 

BEGIN 

IF  (FIELDS! INDEX  3  =  1)  THEN 
FIELDS! INDEX3:=0 

ELSE 

FlELDSIINDEX3:=lf 

WRITELN(’ Field  CHR ( 15) , SPECSl ! INDEX  3  , 
CHR (14),’  changed.  Press  any  ’, 
•key  to  continue.  ’)| 

END; 

GETOPTION (0PT2> ; 
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ERASE  < 1R,4) ; 
displayfields; 

GOTOYy  <0, 19) ; 

WRITELNCAny  changes  to  above  Ijst’’’); 

WR1TELN(’  1  -  Go  with  1 i tt  as  is’); 

WRITELNC’  2  -  Changcis)  required’): 

GETOPTION(OFT) ; 

while  lOFTO’l’)  AND  (OFTO’2’)  DO 
GETOPTION(OPT) ; 

END;  (•  End  o-f  WHILE  loop  ♦) 

<*•!+*) 

END:  <♦  End  o-f  CHANGE  FIELDS  *) 

PROCEDURE  LIMITECHO; 

BEGIN 

ERASE ( 5 , & ) ; 

G070XY (0,5) ; 

WRITELNC  Select  -fields  to  be  echoed:  ’,CHR(15), 

’ <1 -Yes, 2-No) ’ ,CHR(14) ,CHR (13) ) : 

FOR  l:=l  TO  WIDTH  DO  (•  Get  Fields  •) 

BEGIN 

WRITE<I:2,’.  '.BPECSUn,’ 
getoption<opt2) : 

WHILE  <0PT2<>’1’)  AND  (0PT2<>’2’>  DO 
GET0PTI0N(0PT2> : 
writeln: 

FIELDSCn:«-(DRD(0PT2>-50)  :  (•  Bet  to  1  Dr  0  *) 

END;  (*  End  of  Get  Fields  •) 

ERASE (S, IG) : 

GOTOXY (0,5)  ; 

WRITELN  (’ Li  mi  ted  echo  checl^  oF  Following  Fields!’); 

DISPLAYFIELDS; 

CHANGEFIELDS; 

ERASE (5, 16) : 

END;  <*  End  oF  LIMIT  ECHO  *) 

PROCEDURE  ECHODATA; 

BEGIN 

FOR  INDEX:*l  TO  NUMREC  DO  (•  Echo  the  data  •) 

BEGIN 

IF  ((INDEX  MOD  14>)>0)  THEN  (a  Page  pause  a) 
BEGIN 

GOTOXY (22, 22) ; 

WRITE(’Prees  any  key  to  continue  ’>; 
BET0PTI0N(0PT2) J 
ERASE (5, 18) ( 

GOTOXY (0,5) f 


IF  (PRINTER)  AND  (0PT3=’2’>  THEN 
WRITE  (PTR,  INDEXM,  '  ':4); 

FOR  l:=l  TO  WIDTH  DO 

IF  (FIELDS! 1 3=1 )  THEN 
BEGIN 

fieldwidth: =SPECsr c i 3 ; 

WR1TE(DATA[1NDEX, I  3 : F lELDW I DTH: 5 ) : 

fieldwidth: =F1ELDW1DTH*4; 

IF  (PRINTER)  AND  (DFT3=’2’)  THEN 
WRITE (PTR, 

DATA! INDEX, I  3 : FIELDWI DTH: 5 ) ; 

END; 

WRITELN; 

IF  (PRINTER)  AND  (0PT3=’2')  THEN 
WRITELN (PTR) ; 

END; 

END;  (*  Ena  O'!  ECHO  DATA  *) 


(*  Main  body  o-f  ECHOFILE  *) 


BEGIN 

NUMREC:=SPECS2C-n; 

W1DTH:*SPECS2!C>3  5 

WRITELN(CHB (12) , ’  ’ : 26, CHR ( 15) , ’  ECHO  DATA  ROUTINE 
CHR (14)); 

GDT0XY(0,5)  ; 

WRITELNCDo  you  d*Bire  a  limited  echo  chec  k’’* ,  CHR  ( 13)  )  ; 
WRITELN (’Select  desired  option;’); 

WR1TELN(’  1  -  Limited  echo  check’); 

WRITELN (’  2  -  Complete  echo  check’); 

BETOPTION(OPTl); 

WHILE  (OPTlO’l’)  AND  (0PT1<>’2’)  DO 
GETOPTION(OPTl) ; 

ERASE (5,5) ; 

IF  (0PT1=’1’>  AND  (WIDTHXO)  THEN  (•  Limited  echo  check  •) 
LIMITECHO; 

IF  <OPTl*’2’)  AND  (WIDTH>0)  THEN  (•  Complete  echo  check  *) 
FOR  l:*l  TO  WIDTH  DO 
FIELDS! I3:»i; 

IF  (PRINTER)  THEN  (*  Hardcopy  desired’’  *) 

BEGIN 

GOT0XY(0,5) ; 

WRlTELN(’Do  you  want  a  hardcopy’’’ , CHR  ( 13)  )  ; 

WRITELN (’Select  desired  option:’); 

WRITELN (’  1  -  Screen  only’); 

WRITELN(’  2  -  Screen  and  printer’); 

BET0PTI0N(0PT3) ; 

WHILE  <0PT3<>’1’)  AND  (OPT3<>’2’)  DO 
BeT0PTI0N(0PT3) ) 

IF  <0PT3-’2’)  THEN 

WRITELN(PTR,CHR(15) ) ;  (*  Compressed  printing  a) 

ERASE (5, 5) ; 
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(•  Print  the  echo  check  *) 


IF  (PRINTER)  AND  (0'^T3=’2‘)  THEN 
BEGIN 

WRITELN (PTR, 'ECHOCHECK  DF  CURRENT  DATAFILE: 

WRITE (PTR.CHR ( 13) , ’ INDEX’ , ’  ' : 3) : 

END; 

GDT0XV(0,3) ; 

FOR  l;=l  TO  width  do  (*  Field  names  *) 

IF  <FlELDSCn=l)  THEN 
BEGIN 

WRITE (SPECSIC I3:SPECS2[ 13); 

FIELDWIDTH:=SPECB2C I  3+4; 

IF  (PRINTER)  AND  <OPT3='2’)  THEN 

WRITE (PTR.SPECSl I  I  3 : F lELDW I DTH) ; 

END; 

WRITELN (CHR ( 13) ) ;  (*  Carrage  returns  •) 

IF  (PRINTER)  AND  (0PT3=’2’)  THEN 
WRITELN (PTR.CHR (13) ) ; 

ECHODATA; 

B0T0XY(16,22) ; 

WRlTECEnd  oF  Echo  Data.  Press  any  key  to  continue  ’); 
GET0PTI0N(0PT2) ; 

IF  (PRINTER)  AND  (0PT3=’2’)  THEN 
WRITELN (PTR.CHR (13) ) ; 

END;  (*  End  oF  ECHOFIlE  *) 


(*  Initialization  part  oF  UNIT  *) 


(♦*B**) 


UNIT  MU_F;  intrinsic  CODE  16; 

INTERFACE 

USES  TRANSCEND,  MAIN_UNIT; 

PROCEDURE  ASSIGNVARIABLESCVAR  SPECS  1 : HEADER  1 ; VAR  SPECS2, 

GROUP: HE ADCRC; CAT; INTEGER; 

VAR  FEAS; BOOLEAN) ; 

PROCEDURE  CALCULATE (VAR  XBAR, SDEv: VECTOR ; VAR  DATA: RAWDATA; 

VAR  SPECS! : HEADER) : VAR  GROUP: HEADERC : 
NUMREC,  WIDTH: I NTEBER ; PR  1 NTER : BOOLEAN > ; 

IMPLEMENTATION 


<*  Main  part  o-f  MU  F  *) 


PROCEDURE  ASSIGNVARIABLES; 


*  ) 

This  procedur*  allows  the  user  to  select  from  the  *> 

variables  in  SPECS!  and  assign  a  GROUP  value  *> 

to  variables  desired  for  analysis  based  on  •) 

CATegory  <1*CANCOR,2=FACTOR) :  *) 

*) 

0  -  Not  selected  *) 

1  -  Criterion  Variable  (CANCOR)  a> 

2  -  Predictor  Variable  (CANCOR)  a) 

3  -  Manifestation  Variable  (FACTOR)  a) 

a) 

aaaaaaaa««****««««««««««aaaaaaaaaaaaaaaa«aaaaaaaaaa«aa*««a) 


VAR 


I, 

(a 

Iteration  counter 

*) 

INDEX, 

(a 

Field  index  into  arrays 

*) 

P, 

(a 

Number  of  Cri ter ions 

*) 

K, 

(a 

Number  of  Predictors 

♦) 

N, 

(a 

Number  of  Manifestations 

*) 

ROW, 

(a 

Row  on  screen 

*) 

width; 

<a 

Number  of  fields 

♦) 

INTEGER; 

OPT: 

(a 

Menu  Options 

a) 

CHAR; 

DONE: 

(a 

Completion  indicator 

boolean; 

(aaaaaaeaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 
<*  Internal  Procedures  a) 
(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 


PROCEDURE  CHECKS I ZE I 
BEGIN 

CASE  (CAT)  OF 

l;  IF  (W1DTH<4)  THEN 
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BEGIN 

DONE; =TRUE; 

FEAS: =false; 

BCT0XV<1,20) ; 

WRITELNtCHR ( 15) , ’WARNING: ’ , CNR ( 14) , 

’  There  must  be  at  least  4  ’ , 
'variables  in  the  data  base  to 
'run  CANCOR. ’ , CHR ( 13) ) ; 

WRITE<’  ’:ll, 'Press  any  fcey  to  continue. 
GOTOXy ( 1 , 20) ; 

GETOP7ION(OFT) 

ERASE (20,3) ; 


2:  IF  (WIDth<2)  then 
BEGIN 

D0NE:=true; 

feas:=false; 

GOTOXY (1,20) ; 

WRITELN(CHR ( 15) , 'WARNING: ’ , CHR (14) , 

’  There  must  be  at  least  2  ’, 
'variables  in  the  data  base 
'to  run  FACTOR. ’, CHR (13) > ; 

WR1TE(’  ':ll, 'Press  any  key  to  continue.’) 
GOTOXY (0,20) ; 

GETOPTION(OPT) ; 

ERASE (20, 3) ; 

END; 

END!  <*  End  o-f  CASE  *) 

END!  <«  End  O'f  CHECK  -field  list  SIZE  *) 


PROCEDURE  DISPLAYSPECS; 


BEGIN 

GOTOXY (0,7) ; 

FOR  l:»l  TO  WIDTH  DO 

WRITELN(l;7,SPECS2CI3: 12, ’ 
END;  <*  End  o-f  DISPLAY  SPECS  •> 


;6,SPEC51 1  n, CHR  (29)  )  ! 


PROCEDURE  GETVALIDINDEX! 

BEGIN 

<**I-*> 

RESET (INPUT) ; 
READ (INDEX) f 


WHILE  <I0RESULT*14)  OR  (INDEXO)  OR  < INDEX >WIDTH)  DO 
BEGIN 

B0T0XY(1,21)» 

WRITELN(CHR (15) , 'WARNING: CHR (14)  ,  ’  Bad  ', 
'IhdeK.  Hust  be  an  integer  between  ', 
'1  and  '.WIDTH,'.')! 

WRITELN('  ’;il, 'Press  any  key  to  try  again’); 
BOT0XY(0,21)| 


GETOPTION(OFT)  ; 

ERASE (20,3) ; 
G0T0i(Y<0,20)  ; 

RESET (INPUT' ; 

READ (INDEX) ; 

END; 

(**!+*) 

END;  (*  End  o-f  GET  VALID  index  *> 


PROCEDURE  ASSIGNOR I  TER I  on; 

BEGIN 

WRITELN) ’Enter  index  ( 1-' , WIDTH, ’ )  o4 
’criterion  variable:’); 
GETVALIDINDEX; 

ERASE (18,3); 

group: indexi:=i; 
p:»p*i ; 

BR0UPC-i]:=p; 
row: = INDEX *6; 

GOTOXY (39, ROW)  ; 

WRITE (CHR (15) , ’CRITERION’ ,CHR( 14) )  ; 
END;  (♦  End  o-f  Assign  Criterion  *) 

PROCEDURE  ASSIGNPREDICTOR; 

BEGIN 

WRITELNC Enter  index  ( 1 WIDTH, ’ )  o4 
'predictor  variable:’); 
GETVALIDINDEX; 

ERASE (IB, 3) ; 
group: INDEX j: =2; 
k;«k-h  ; 

GR0Up:03:«k; 
row:  *:INDEX*6; 

GOTOXY (39, ROW) ; 

WRITE (CHR ( 15) , ’PREDICTOR’ ,CHR( 14) ) ; 
END;  <«  End  o-f  Assign  Predictor  *) 

PROCEDURE  ASSIGNMANIFESTATION; 

BEGIN 

WRITELNC Enter  index  < 1-’ , WI DTH,  ’  )  ot 
’ mam 'f estat i on  variable:’); 
GETVALIDINDEX; 

ERASE (18, 3); 
group: INDEX  I : >3; 
n: *n* 1 ; 
group: 03 :-Ni 
R0W;-INDEX-»6; 

GOTOXY (39, ROW) ; 

WRITE <CHR< IS) .’SELECTED’ ,CHR< 14) > ; 
END;  (•  End  o4  Assign  Manifestation  •> 


( 


) 


PROCEDURE  REMDUEASSIGNMENT; 

BEGIN 

WRlTELNCEnter  index  <  1  -  *  ,  W I  D'^H ,  ’  )  of 
’variable  to  remove: ’> i 
GETVALir index; 

IF  (GROUP  I  INDEX  I >0)  AND  (GROUP! 1 NDE X  I < 4 )  THEN 
BEGIN 

CASE  (GROUP! INDEX!)  OF 
l:  BEGIN 

P:=F-i ; 

GROUPi-1 3:=P; 

END; 

2:  BEGIN 

K:«K-) ; 

groufi(!::=k; 

end; 

3:  BEGIN 

N:=N-i; 

Group!03:=n; 

end; 

end;  (*  End  oF  Reduce  CASE  *) 

R0W:=INDEX*6; 

GOTOXY (39, ROW) ; 

WRITE!’  •:20); 

GROUP! INDEX  I :=o; 

END 

ELSE 

BEGIN 

WRITE(CHR(7), ’Sorry.  That  variable  i»n”t  ’, 

’•elected.  Press  any  key  to  continue  ’>; 
GETOPTION(OPT) i 
ERASE (18,5) ; 

END; 

END;  (*  End  oF  Remove  Assignment  *) 

(••••••••••••••••«•••••••••••••••••••••••••••••••••••••*••••«•••••••) 

PROCEDURE  ATTEMPTEXIT; 

BEGIN 

CASE  (CAT)  OF 

l;  IF  (P<2)  OR  <K<2)  THEN 
BEGIN 

WR1TELN(’  ’ ,CHR( 15) , ’WARNING: ’ , 

CHR<14),’  Must  have  at  ’, 

’least  2  variables  oF  each  ’, 
’typB.’,CHR(13))f 
WRITELN(’  ’Ill, ’Press  any  key  ’, 

’to  conti nue’ > ! 

GOTOXY (0, 19) 5 
SET0PT2DN(0PT) » 

ERASE (le, 5) t 

END 

ELSE 

DONE I -TRUE  I 
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2:  IF  (n<2)  then 
BE6IN 

WRITELNC  ’  ,CHR  (  15>  WARNING:  ’  , 

CHR(14),’  Must  select  at 
'least  2  manj -f  estat  1  on 
'  var i abl  es . ’ , CHB (13)); 

WRITELN;’  ’:11, 'Press  any  key 
’ tc  conti nue’ ) ; 

GDTOXV (0, 19) ; 

BETOFT ION (OFT ) ; 

ERASE (16,5) ; 

END 

ELSE 

DONE: =TRUE; 

END;  <*  End  ot  CASE  *) 

END;  (*  End  ot  ATTEMPT  EXIT  •) 

) 

PROCEDURE  GETCHOICE; 

BEGIN 

GOTOXY (0, 16) ; 

WRI TELN < ’ Sel ect  desired  option;’); 

CASE  (CAT)  OF  (*  Display  choices  •) 

l:  BEGIN 

WRITELNC  1  -  Assign  as  Criterion’); 

WRITELN(’  2  -  Assign  as  Predictor’); 

WRITELNf’  3  -  Remove  assignment’); 

WRITELN(’  4  -  Exit  ASSIGN  VARIABLES’); 

END; 

2:  BEGIN 

WRITELN(’  1  -  Assign  as  Manifestation’); 

WR1TELN(’  2  -  Remove  assignment’); 

WRITELNC’  3  -  Exit  ASSIGN  VARIABLES’); 

END; 

END;  <*  End  of  Display  Choice  CASE  •) 

GETOPTION(OFT) ; 

CASE  (CAT)  OF  (*  Accept  choice  ♦) 

i:  WHILE  <0PT<’1’)  AND  (0PT>’A’)  DO 
GETOPTION(OPT) ; 

2:  WHILE  <0PT<’1’)  AND  (OPT >’3’)  DO 
GETOPTION(OPT) ; 

END;  (*  End  of  Accept  Choice  CASE  *) 

CASE  (CAT)  OF  (*  Change  for  correct  •) 

l:  IF  (OPT >’2’)  THEN 

OPT ; «CHR ( ORD ( OFT ) + 1 ) ; 

2;  0PT:«chr(0RD(0PT)+2) ; 

END;  (*  End  of  Change  for  correct  procedure  call  *) 

ERASE ( 16,5) ; 

GOTOXY (0, 19) ; 

END:  <•  End  of  GET  assignment  CHOICE  ♦) 
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name: 


string; 


(•  Field  or  variable  name  *) 


(a******************************************************************) 

(«  Internal  Procedures  *) 


PROCEDURE  CALCXBAR; 


BEGIN 

FOR  INDEX;=1  TO  WIDTH  DO  (*  Calculate  grand  totals  ♦) 

IF  (GROUP! INDEX  1 >0)  THEN 
FOR  I:=l  TO  NUMREC  DO 

XBARC INDEX3:=XBAR[ INDEX3*DATA[ I , INDEX!; 


FOR  INDEX :=1  TO  WIDTH  DO  (*  Convert  to  means  *) 

IF  (NUMREC=0)  THEN 

XBAR [ I NDEX  3 : =99 . 9999 

ELSE 

XBARC 1NDEX3:=XBARC I NDEX 3 /NUMREC ; 

END;  <*  End  of  CALCulate  means  (XBAR)  *) 


( 


) 


PROCEDURE  CALCSDEV; 

BEGIN 

FOR  INDEX:=1  TO  WIDTH  DO  <•  Calculate  grand  totals  ♦) 
IF  <GR0UPCINDEX3>0)  THEN 

IF  <XBARCINDEX3=99.9999)  THEN 
BDEVCINDEX3: -99.9999 

ELSE 

FOR  l:=l  TO  NUMREC  DO 

SDEV[1NDEX3:=SDEVCINDEX3+ 

bqr(data:i, index3-xbar[index3>  ; 

FOR  INDEX:=1  TO  WIDTH  DO  <*  Convert  to  variances  •) 
IF  <NUMREC<2)  THEN 

BDE  V  r I NDE  X3:-99.9999 

ELSE 

60EVCINDEX3:-6DEVCINDEX3/ (NUMREC-1> ! 

FOR  INDEX:=1  TO  WIDTH  DO  (*  Convert  to  standard  dev  *) 
IF  <NUMREC<2)  THEN 

SDEVCINDEX3:-99.9999 

ELSE 

BDEVCINDEXII-SORTCBDEVCINDEX!) ; 

END;  <•  End  of  CALCulate  standard  deviations  (BDEV)  •) 


< 


) 


PROCEDURE  PRINTRESULTS; 

BEGIN 

BOTOXV (0,5) ; 

WRITELN(CHR(15) , ' VARIABLE' : 15, 'MEAN* ; 1 1 , 

'STANDARD  DEVIATION’ : 24, '  ' : 6, CHR ( 1 A) , CHR ( 13) > J 
IF  (PRINTER)  THEN 
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BEGIN 

WRITElN (PTR, ’FILE  ’ .SPECSl COI ,  ’  : ’ , CHR ( 13) ) ; 
WR1TELN(PTR, ’VARIABLE’ :9,  ’MEAN’  :  1  1  , 

’STANDARD  DEVIATION’  : 24 , CMR  (13)  )  ; 

END; 

FDR  I:=l  TO  width  do  <•  Print  Cr i t er i on /Man i test .  *) 

IF  (GROJP[i:=l)  OR  (GROUFCn  =  3)  THEN 
BEGIN 

NAME;=SPECSlCn; 

IF  (LENGTH (NAME) >9)  THEN 
NAME : =COFY ( NAME ,1,9); 

WRITELN(NAME:  15, XBARC ID: 12: 5, SDEVI I D : 16: 5) ; 

IF  (PRINTER)  THEN 

writelN(PTr,name:9, xbarc 1 d: 12: 5, 

SDEVC 1 d: 16:5) : 

END;  <♦  End  of  Print  Criterion  variables  *> 

FOR  I:=l  TO  WIDTH  DO  (♦  Print  Predictor  variables  *) 

IF  (GR0URtID=2)  THEN 
BEGIN 

NAME:-SPECSiriD; 

IF  (LENGTH (NAME) >9)  THEN 
NAME : =COP Y ( NAME ,1,9); 

WBITELN(NAME: 15, XBARI I D: 12: 5, SDEVI 1 D: 16:5) ; 

IF  (PRINTER)  then 

WR1TELN(PTR,NAME:9, XBARI 1 d: 12:5, 

SDEVI 1 D: 16: 5) ; 

END;  <*  End  of  Print  Predictor  variables  *) 

IF  (PRINTER)  THEN 

FOR  l:=l  TO  2  DO 
WRITELN  (PTR)  ’, 

end;  <•  End  o-f  PRINT  RESULTS  *) 


<*  Main  body  of  CALCULATE  *) 


BEGIN 

FOR  index: =1  TO  WIDTH  DO  (*  Zero  out  arrays  *) 

BEGIN 

XBARtINDEXD:=0.0; 

BDEVtINDEXD:«0.0; 

END; 

CALCXBAR;  (*  Means  of  designated  •) 

CALCSDEV;  <*  Stand  Dev  oF  designated  *) 

ERASE(22,1); 

60T0XV(16,22)  ; 

WRITE (CHR (7) Done.  Press  any  key  to  print  results  ’); 
BETDPTIDN(DPT) ; 

ERASE  (22,1); 

PRINTRESULTS:  (*  XBAR’s  and  SDEV’s  •) 


END 


<*  End  OF  CALCULATE  •) 


<*»S**) 


UNIT  MU_G;  INTRINSIC  CODE  17; 

INTER^’ACE 

USES  TRANSCEND,  MAIN_UNIT; 

PROCEDURE  STANDARDIZE (VAR  DATA: RAWDATA; VAR  XBAR , SDEV: VECTOR : 

VAR  GROUP: HEADER2; NUMREC, width: INTEGER; 
option: CHAR) ; 

PROCEDURE  GENMATR'I X (VAR  DATA: RAWDAT A; VAR  CM:MATRix; 

VAR  SPECSl : HEADER! ; VAR  GROUP : HEADER2 ; 
NUMREC, width: INTEGER; PRINTER:  BOOLEAN)  ; 

PROCEDURE  GETCVCS(VAR  CC: VECTOR; VAR  ALPHA, BETA, CM: MATR I X ; 

VAR  SPECSl : HEADER  1 ; VAR  GROUP: HEADER2 ; 
PRINTER: BOOLEAN) ; 


IMPLEMENTATION 


. . * . . . ***** . . 

(*  Main  body  o-f  MU  G  *) 

. . a************* . . . . . . 

PROCEDURE  STANDARDIZE! 

(•••a************************************************** . . . . 

<♦  •) 

<*  This  procedure  standardizes  designated  •♦ields  Nithin  •> 

<*  DATA  depending  on  the  value  of  OPTION;  *> 

<*  *) 

<*  1  -  Mean  Corrected  (Subtract  Mean  only)  *) 

<*  2  -  Standardized  (Subtract  Mean  (■  divide  by  •> 

(*  Standard  Deviation)  •) 

(*  *) 

(♦  The  ■first  option  leads  to  generation  of  a  Sample  *) 

(«  Covariance  Matrix,  the  latter  to  a  Sample  •> 

(*  Correlation  Matrix.  *) 

(*  *) 

(••••a**************************************************************) 

VAR  I, J; INTEGER;  (•  Iteration  counters  ♦) 

BEGIN 

IF  (0PTI0N=’l’)  THEN  (*  Subtract  Means  only  •) 

FOR  J:«l  TO  WIDTH  DO  (*  of  designated  vars  *) 

IF  (GR0UPCJ3>0)  THEN 

FOR  I;-l  TO  NUMREC  DO 

DATA! I , J I : >DATA[ 1 , J  3-XBARC  J  3  ; 


IF  (0PTI0N»*2’)  THEN  (*  Bub  Means  k  Di v  by  SD  •) 

FOR  J:>1  TO  WIDTH  DO  (•  of  designated  vars  *) 

IF  (GR0UPCJ3>0)  THEN 

FOR  l;-l  TO  NUMREC  DO 

IF  (NUMREC<2)  OR  (BDEVC J 3-0. 0)  THEN 
DATA! I , J  3 : *99. 9999 

ELSE 

DATACI, J3:-(DATACI, J3-XBARCJ3)/6DEV[J3f 
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end;  <♦  End  o-f  STANDARDIZE  *) 


M 

W 


I 


! 

i 

i 


I 


I 


PROCEDURE  GENMATRIX; 

<*  *) 

(*  This  procedure  generates  and  prints  the  Sample  *) 

(*  Correlation  Matrix  (CM)  o4  the  designated  *) 

<*  ■fields  b'/  -first  generating  smaller  first  and  *) 

(*  second  set  sel f -correl at i on  matrices  and  the  #) 

(*  first/second  cross-correlation  matrix,  *) 

<*  These  partitions  are  stored  in  CORRMATRIX  (CM).  *) 

(*  *) 

(«•«•»••*•«•••••••••••*••••*«*««••••••«••••••••••••»•«•••••«*••«*•«•) 


VAR 


<* 

<♦ 

<* 


I  9  J  9  L  f 

(* 

Ite’-ation  counters 

*) 

INDEX, 

(• 

Field  in  arrays 

•  ) 

P, 

(* 

Number  in  let  set 

*) 

k: 

INTEGER; 

(* 

Number  1 n  2nd  set 

*) 

MULT: 

REAL) 

(• 

Statistical  reducer 

•  ) 

OPT: 

CHAR) 

(• 

Menu  option 

*) 

name: 

STRING) 

(• 

Field  /  variable  name 

•  ) 

a: 

(* 

Array  of  pointers  to 

*) 

HEADER2) 

<* 

next  same  type  field 

*) 

Internal  Procedures 

1*) 

•  ) 

) 


PROCEDURE  SETPO INTERS) 

BEGIN 

FOR  l;-l  TO  WIDTH  DO 

IF  (GROUP! I  3  =  1 )  OR  (GROUP! I  3  =  3)  THEN 

BEGIN  <*  1st  or  only  set  *) 

INDEX:»1NDEX-»1; 

A! INDEX3:=I5 

END) 

FOR  l:=l  TO  WIDTH  DO 

IF  (GROUP! 1 3=2)  THEN  (*  2nd  set  *) 

BEGIN 

INDEX:=INDEX*l; 

A!INDEX3:=I{ 

END) 

END)  <*  End  of  SET  sequential  POINTERS  by  type  *) 


< 


) 


PROCEDURE  QETMATRIX) 


FDR  J:=(1*1)  to  p  do 
BEGIN 

CHt i,j3:=o.o; 

FOR  L:=1  to  NUMREC  DO 
CMCi, J3:=CMr I, J3* 

(DATACL.RC  n3»DATAr L, A[ J]] ) ; 

CMC  I , J3 : =CMC 1 , J 3*MUL T;  («  Upper  diagonal  *) 

CMC J , I  3 : =CMt 1 , J 3 ;  (•  Lower  diagonal  *' 

END;  <*  End  o-f  Ist  set  tel  -cor  r  e )  at  i  on  matrix  *! 

FOR  I:=(P*1)  TO  (P+F)  DO  (*  2nd  set  seW-corr  *) 

FDR  TO  <P*F>  DO 

BEGIN 

CMCI,J3:=0.0; 

FOR  L:=1  to  NUMREC  DO 
CMCI,J3:=CMri,  J3-» 

(DATACL,  AC  I  3  3 ‘DAT  AC  L ,  AC  J  3  3  )  ; 

CMC  I , J 3 ; =CMC I , J 3*MULT;  (•  Upper  diagonal  *) 

CMC  J  ,  I  3  :  ■=CM[  1 ,  J  3  ;  (•  Lower  diagonal  *) 

END;  <*  End  o-f  2no  set  sel  + -cornel  at  i  on  matrix  *) 

FOR  I:=l  TO  P  DO  (*  Cross  correlation  *) 

FOR  J:=<P*1)  TO  <P+K)  DO 
BEGIN 

CMC  1 , J3:=o.o; 

FOR  L;=1  to  NUMREC  DO 
CM[I,J3:»CMCI,  J3  + 

<DATACL,A:i33«DATACL,AtJ33) ; 

CMCI,  J3:»CMtI, J3«MULT;  (*  First/Sec  cross  *> 

CMC J ,  I  3 : eCMC I , J 3 ;  (*  Sec/First  cross  *> 
END;  <«  End  O'f  Cross  correlation  matrices  *) 


FOR  I;*I  TO  <P+K)  DO 
CMCI, l3:«t.o; 

end;  <•  End  o-f  GET  the  MATRIX  *) 


<*  Main  Diagonal  to  1  *) 


PROCEDURE  PRINTMATRIX; 


BEGIN 

GOTOXY<10,5) ; 

FOR  I:«l  TO  (P-*K)  DO  («  Display  header  row  *) 

BEGIN 

NAME: -SPECS 1 CAt I  3  3 ; 

IF  (LENGTH (NAME) >7)  THEN 

NAME : -COPY  (NAME,  1,7)  ;  («  Truncate  to  -fit  *> 

MRITE(NAME:8) ; 

END; 

MRITELN(CHR(13) ) f 


IF  (PRINTER)  THEN  (*  Print  header  row  *) 

BEGIN 

WR I TELN(PTR, 'CORRELATION  COEFFICIENTS: ' ,CHR( 13) ) ; 
WRITE(PTR,'  ';lO); 

FOR  l;-l  TO  (P-fK)  DO 
BEGIN 


NAHE:=SPECSlCAri33; 

IF  (LENGTH (NAME ' >1 1 )  THEN 

NAME; =COPv (NAME , 1 , 11 ) ;  (*  Truncate  *) 

WR1TE(PTF,NAME: 12) ; 

END; 

WRITELN(PTK,CHR(1T.)  )  ; 

END;  (*  End  o^  Di tpl ay/Pr i nt  Header  Rows  *) 

FOR  1:  =  1  TO  (P+K)  DO  (*  Di sp 1  ay /Pr 1 nt  Matrix  *) 

BEGIN 

NAME:=EPECSltAC13D; 

IF  (LENGTH (NAME) >9)  THEN 

NAME  :»=COPY(  NAME,  1,9)  ;  (*  Truncate  *) 

WRITE(NAME; 9, '  ’ ) ; 

IF  (PRINTER)  THEN 

WRITE (PTR, NAME: 9, ’  ’); 

FOR  INDEX:=1  TO  (P*K)  DO 
BEGIN 

WRITE (CMC  I , INDEX  3: B: A) ; 

IF  (PRINTER)  THEN 

WRITE (PTR, CMC  I , INDEX  3:  12:4); 

END; 

WRITEln; 

IF  (PRINTER)  THEN 
WRITELN(PTR) ; 

END;  (*  End  O'f  Di  spl  ay /Pr  i  nt  Matriw  *) 

IF  (PRINTER)  THEN 

FOR  l:=l  TO  2  DO 
WRITELN (PTR)  ; 

END)  (a  End  o-f  PRINT  the  correlation  MATRIX  a) 


(aaaaaaaaaaaaaaaaaaaaeaaaaaaaaeaaaaaaaaaaaaaaaaaaaaaaaaaa***********) 

(a  Main  body  of  BENMATRIX  *) 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa**************) 


BEGIN 

P:«GRDUPC-13;  (a  Initialize  parameters  a) 

k;-groupco]; 

indexing; 

MULT:  =  1 / (NUMREC-1  )  i 

SETPOINTERS;  (a  Fill  pointer  array  •) 

BETMATRIXi 

ERASE (20, 3) i 
S0T0XY(16,22) ; 

WRITE (CHR (7) Done.  Press  any  key  to  print  results.  ’); 
BETOPTION(OPT) ; 

ERASE (22,1); 

B0T0XY(0,2) ; 

WRITELN (’CORRELATION  COEFFICIENTS’ ; 2B) f 
PRINTMATRIX; 
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PROCEDURE  GETCUCS 


<* 

(* 

<* 

<* 

(* 

<* 

<* 

(* 

<* 

<* 

<* 

<* 

<* 

<* 

VAR 


1 ,  J  ,  L , 

(* 

Iteration  counters 

*) 

P, 

(* 

Number  o-f  cr  iter  ions 

* ) 

K. 

(* 

Number  of  predictors 

*) 

n: 

integer; 

(* 

Lesser  of  P  and  K 

* ) 

scale: 

real; 

(♦ 

CVC  Normalize  factor 

•  ) 

opt: 

char; 

(* 

Menu  option 

*) 

NAME: 

string; 

<* 

Variable  name 

*> 

NAMES: 

HEADER  1 ; 

(* 

Sorted  variable  names 

*) 

TEMP: 

vector; 

(* 

Used  in  scaling 

#) 

MMULT, 

(* 

Matrix  multiplier 

*> 

RXX, 

<* 

R(XX)  partition 

«) 

Rxxinv: 

matrix; 

<* 

R<XX)  inverse 

*) 

peas; 

boolean; 

<* 

Used  in  INVERT  routine 

♦  ) 

•««•«••••**•** •••••••••••••«*«••*••*«•*•• ••••*•«••*«*••••• ) 

•  ) 

This  procedure  calculates  the  Canonical  Variate  *) 

Coe-f -f  1  c  1  ents  (Alpha  ti  Beta)  +or  both  sets  o^f  *) 

variables  <X  &  V)  and  prints  them.  Note:  The  *) 

Alpha’s  are  the  normalized  eigenvectors.  •) 

* ) 

ALPHA  =  1/SQRT(C)  *  ALPHA  *) 

where  C  =  ALPHA’  *  R(YY)  *  ALPHA  «) 

*) 

-1  *) 

BETA  =  (1/CANCOR)  *  (R<XX)  *  R(XY)>  *  ALPHA  *) 

*) 


<•  Internal  Procedures  *) 


PROCEDURE  INVERT <N: INTEGER; VAR  PEAS: BOOLEAN; VAR  R, IN: MATRl X ) ; 


VAR 

I,J,  <*  Iteration  counters  ♦) 

RO(»l,  <•  Pivot  row  *) 

COL:  <a  Pivot  column  ♦) 

INTEGER; 

T,  (•  Pivot  element  on  main  diagonal  •) 

CM,  <*  Column  multiplier  *) 

TR,  (*  Subtracted  4rom  matrix  R  *) 

TIM:  <*  Subtracted  ♦rom  matrix  IM  *) 

real; 


<• 

<• 


Procedures  internal  to  INVERT 


*) 

*) 


( 


) 


PROCEDURE  initialize; 

BEGIN 

FOR  I:=l  TO  N  DO 

FOR  J:=l  TO  N  DO 
BEGIN 

IHCI, Ji:=0.0; 

IF  (I=J)  THEN 

IMCI, J3:=1.0; 

END: 

END;  <*  End  o-f  INITIALIZE  *) 


< 


) 


PROCEDURE  SCALEPlVOTROw; 

BEGIN 

FOR  j:=i  to  n  do 
BEGIN 

RCROW, Jl: =RCROW, J I /T; 
IMCROW, J3:=1MCR0W, J:/T; 

END; 

END;  <*  End  o-f  SCALE  PIVOT  ROW  *) 


< 


) 


PROCEDURE  REDUCEROWS; 

BEGIN 

cm:=-rci,coli; 

FOR  J:=l  TO  N  do 
BEGIN 

TR:-RCR0W, J3*CH; 

TIM:=IMtROw, J3*CM; 

Rtl, J3:«Rti, J3+TR; 

IF  <ABS<R[I,J3)<0. 000001)  THEN 

RCi, J3:=o.o; 

IMCI,J3:=IMCI,03+TIM; 

IF  (ABSdMCI, 33X0.000001)  THEN 

IMCI, J3:=o.o; 

END: 

END;  (•  End  o-f  REDUCE  ROWS  •) 


(••••••••••••••••••••••••••••••«••••••••••««•««•«««••••«•««•«««««««•) 

<*  M«in  body  o-f  INVERT  Procedure  *) 


BEGIN 

INITIALIZE; 

FEAS:-TRUE; 

FOR  R0W:«1  TO  N  DO  (*  First  scan  •) 

BEGIN 

col: -row; 
t;-rcrow,coli; 


<  o 


[•IM 


IF  (TOO.O)  THEN 
BEGIN 

IF  (TOl.O)  THEN 
SCALEFIVOTRDW; 

FOR  l:=l  TO  N  DO 

IF  (1<>RDUI)  THEN 
REDUCEROWB: 

end: 

END;  (*  End  of  First  Scan  *) 


FOR  ROW;=l  TO  N  DO 
BEGIN 

COl;=row; 

T:=RCROH,COL3; 


(*  Second  Scan 


IF  <T=0.0)  THEN 
FEAS: =FALSE 

ELSE 

IF  (TOl.O)  THEN 
SCAlEPIVOTROW; 

FOR  I : =1  TO  N  DO 

IF  (lOROW)  AND  (FEAS)  THEN 
REDUCEROWS; 

END;  (♦  End  o-f  Second  Scan  *) 

END;  <*  End  o-f  INVERT  *) 


PROCEDURE  SCALE ALPHAS; 


BEGIN 

FOR  L:*1  TO  N  DO  (*  Scale  the  Alpha’s  *) 

BEGIN 

FOR  l:=l  TO  P  DO 
BEGIN 

TEMPI  n:  =0.0; 

FOR  J:=l  TO  P  DO 

TEMPI  n;=TEMPt  I 

ALPHAtJ,L3«CMtJ, I ]; 

END; 

SCALE: «0. 05 
FOR  I:«=l  TO  P  DO 

SCALE:  -SCALE TEMPI  I  ]*ALPHAI  I ,  LD  5 

FOR  l:-l  TO  P  DO 

IF  (SCALE=0.0)  OR  (ALPHAI I , L3=99. 9999)  THEN 
ALPHAI I ,L3; -99. 9999 

ELSE 

ALPHA! I,L3:-(1.0/SQRT (SCALE) ) SAUPHAI I ,  LI ; 

END; 

END;  (*  End  o-f  SCALE  the  ALPHA  vectors  ♦) 


PROCEDURE  CALCBETAS; 
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(*  Get  R(XX)  inverse 


FOR  1:=1  TO  K  DO 

FOR  J:=l  TO  K  DO 

RXX  f 1 , j: : =CMt  ( I+P) ,  ( J+P)  ] ; 


INVERT (K,FEAS,RXX,RXXINV) ; 

(*  - 1  * ) 
FOR  I:=l  TO  K  DO  (*  Get  R(XX)  *  R(Xt)  *) 

FOR  J:=l  TO  P  DO 

FOR  L:  =  1  TO  DO 

MMU1.TC  I  ,  J3:  =MMULTC  1  .  :  J  + 

(RXX INV[  I , L]*OM[  (L  +  P;  , J  3  '  ; 


FOR  I:=l  TO  N  DO  (*  Calculate  the  BC'As  *) 

FOR  J : = 1  TO  F  DO 

IF  (CCt I  3  =  99.9999)  OR  (CCCI3=0.0)  THEN 
BETACJ, I 3:=99. 9999 

ELSE 

BEGIN 

FOR  l:=i  to  p  do 

BETACJ, I3:=BETA[ J, 13+ 

(MMULT[J,L3*ALPNACL,  13)  ; 
BETACJ, 1 3:  =  (1. 0/CCC  3  3 ) *BETA[  J,  1  3  , 

END; 

END;  <*  End  ot  CALCulate  the  BETA  vectors  *) 

<•«*****•••••««••«•••*****••••«•••••••••••«««•«•••«•*••••««•••«•«**« ) 

PROCEDURE  PRINTFIRSTSET; 

BEGIN 

GOTOXY  <0, 3) ; 

WRITELNl -coefficients  FOR  CANONICAL  VARIABLES  OF  ’, 

•THE  FIRST  SET* ) ; 

gotoxy (0,5) : 
write;*  ’IIS); 

FOR  l:=l  TO  N  do 

write;’  canvar* , i:2) ; 

IF  (PRINTER)  then  (*  Printer  headings  *) 

BEGIN 

WRITELN(PTR, ’COEFFICIENTS  FDR  CANONICAL  ’, 

’VARIABLES  OF  THE  FIRST  BET  * , CHR  ;  1 3 )  ) ; 
WRITE ;PTR,’  ’:J5); 

FOR  1:=1  TO  N  DO 

WRITE (PTR,’  CANVAR* , I : 2) ; 

WRITELN(PTR,CHR(13) ) ; 

END; 

B0T0XY;0,7);  (•  Get  NAMES  ot  First  set  «) 

J  •  *0 ; 

FOR  l:=l  TO  (P+K)  do 

IF  <GR0UPCI3=1)  THEN 
BEGIN 

J:«J+i ; 

NAME6CJ3:=SPECG1 C 13; 

END; 

FOR  I : -I  TO  P  DO  (*  Print  First  set  *) 

BEGIN 

NAME: -NAMES C 13; 


V-y 


y'~' 


-■  •r, 

\  • 


IF  (LtMGTH(NAME) >15)  THEN 
NAME ; =COF  Y ( NAME ,  1 ,  15); 

WRITE (NAME: 15) ; 

IF  (PRINTER)  THEN 

WRITE (PTR.NAME: 15) ; 

FOR  J:=l  TO  N  DO 
BEGIN 

WRITE ( alpha: I , Ji: 10: 4) ; 

IF  (PRINTER)  THEN 

WRITE  (PTR,  A;.PHA[  I  ,  J  I  :  10:  4  )  ; 

END; 

WRITELN; 

IF  (PRINTER)  Then 
WR:TEi-N(PTR)  ; 

END; 

END;  (*  End  oP  PRINT  the  FIRST  SET  oP  coePPieients  «) 

(•«•••*«••**•••••••«*•••••••••«*••••*••«•<«*««««««««««««««<««««««*««) 

PROOEDJRE  PRINTSECQNDSET: 

BEGIN 

WRITElN (CHR ( 13) COEFFICIENTS  FOR  CANONICAL  VARIABLES 
'OF  THE  SECOND  SET ’ , CHR ( 1 3 ) ) ; 

WRITEC  ’llS); 

FOR  I : =1  TO  N  DO 

WRITE!’  CANVAR’ , 1 : 2)  ; 
wr:teln(chr(13)  > ; 


(♦  Printer  he»ding6 


IF  (PRINTER)  THEN 
BEGIN 

WR1TELN(PTR, CHR (13) , ’COEFFICIENTS  FOR  CANONICAL’, 
’  variables  of  the  SECOND  SET’ ,CHR ( 13) ) : 
WRITE(PTR,’  ’;i5); 

for  i;=i  to  n  do 

WRITE (PTR,’  CANVAR’ , I : 2) ; 

WRITELN (PTR, CHR ( 13) ) ; 

END; 

J:=0;  («  Get  NAMES  oP  second  set  *) 

FOR  l:=l  TO  (P+K)  DO 

IF  (group: I  3  =  2)  THEN 
BEGIN 

J : =3+1 ; 

names: J3:=SPECS  t I 3; 

END; 


FOP  i:=i  to  k  do 
BEGIN 

NAME : -names: I  3; 

IF  (LENGTH(NAME) >15)  THEN 
NAME. -COPY (NAME, 1,15); 
WRITE (NAME: 15) ; 

IF  (PRINTER)  THEN 

WRITE (PTR, NAME: 15) ; 

FOR  J:«l  TO  N  DO 
BEGIN 


(*  Print  second  set 


*) 
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WRITE (BETAC I , Jl; 10; 4) ; 

IF  (PRINTER)  THEN 

WRITE (PTR, BETA! I , J] : 10: 4) ; 

END; 

writeln; 

IF  (PRINTER)  THEN 
WRITElN(FTR) ; 

END; 

IF  (T-  INTER)  THEN 

WRITELN(PTR,CHR(13) ) ; 

END;  (*  End  oF  PRINT  the  SECOND  SET  oF  coeF  F  i  c  i  er,  ts  «) 


(*  Main  body  oF  GETCVCS  *) 

(•••«•••••••««««•••«*••<•«•«••«•«««•••«*«««•««•«•«*«•«•*••**»•*•••«*) 

BEGIN 

(••R  TRANSCEND  «)  (*  Retain  UNIT  in  menory  *) 

P: =GR0UR[- 1  I ;  (*  Initialize  parameters  *) 

«;=GR0UPI03; 

IF  (P>K)  THEN 
N:  =K 

ELSE 


N:=p; 

FOR  l:=l  TO  K  DO 

FOR  J: =1  TO  P  DO 
BEGIN 

MMULTri,J3:=0.0; 

BETACl,J]:=o.o; 

END; 

BCALEflLPHAS;  (*  Scale  ALPHA  vectors  «) 

CALCBETAS;  (*  Calculate  BETA  vectors  *) 

ERASE (22, 1 ) ; 

GOTOXY ( 16, 22) ; 

WRITE(’Done.  Press  any  key  to  print  results.  ’>1 
GETOPTION (OPT) ; 

ERASE (22, 1 )  ; 

PRIN'^FIRSTSET; 

PRINTSECONDSET; 

GOTOXY (16,22) ; 

WRITE(’Done.  Press  any  key  to  continue.  ’); 

GETOPTION (OPT) ; 

ERASE (3,20) ; 

;  <•  End  oF  GET  Canonical  Variate  CoeFFicientS  *) 


END 


(*•=+*) 


UNIT  MU_H;  intrinsic  CODE!  18; 

INTERFACE 

USES  MAIN_UNIT; 

PROCEDURE  INVERT (N: INTEGER; VAR  FEAS : BOOLE AN ; 

R:matrix;var  imimatrix); 

PROCEDURE  PREFTOEIG(Cri:MATRIX;P,F: integer; VAR  A:MATRIX; 

VAR  FEAS : boolean > ; 

PROCEDURE  EIGEN(N: INTEGER;A:MATR1X; VAR  VlMATRIX; VAR  EIVECTOR); 
implementation 


(•**«•«•«••••••«••••*••*•••••••••••••••«•••«•••«•••**•••»«•*«•••*•••) 

(♦  Main  body  o-f  MU_H  *) 


PROCEDURE  INVERT; 


(•••••••••••••••••••••••••••••a************************************* ) 

(  •  *  ) 

<*  This  procedure  needs  as  input:  ♦) 

<  *  * ) 

<*  N  -  Order  O'*  matrix  to  be  inverted  •) 

<*  R(N,N)  -  Matrix  to  be  inverted  *) 

'*  •) 

<*  Tnia  procedure  returns  as  output:  *) 

<«  *) 

<*  IM(N,N)  -  Inverted  matrix  a) 

(a  FEAS  -  Returns  FALSE  i  no  inverse  exists  a) 

<a  « ) 


VAR 


I,  J, 

(a 

Iteration  counters 

*  ) 

ROW, 

<a 

Pi vot  r  ow 

*  ) 

col; 

(a 

Pivot  column 

*) 

INTEGER; 

T, 

<* 

Pivot  element  on  main  diagonal 

#) 

CM, 

(a 

Column  multiplier 

«  ) 

TR, 

(a 

Subtracted  -from  matrix  R 

*  ) 

TIM: 

(a 

Subtracted  -from  matrix  IM 

*) 

REAL  5 

« 

Internal  Procedures 

) 

•  ) 

»•  ) 

PROCEDURE  INITIALIZE; 


BEGIN 

FOR  l:«l  TO  N  DO 

FOR  J:-l  TO  N  DO 
BEGIN 


IMCI,J3:-O.C; 
IF  (I«J)  THEN 
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(*  Second  Scan 


FOR  R0W:=1  TO  N  DO 
BEGIN 

col; =Rrw; 
t:»:RCR0i*,C0L3; 

IF  (T=0.0)  THEN 
FEA5: =FALSE 

ELSE 

IF  (T<->1.0)  then 
sgalep-i  vothok; 


FOR  l:=l  TO  N  DO 

IF  (K>ROW>  AND  (FEAB)  THEN 
REDUCEROWS; 

END;  (•  End  o-f  Second  Scan  *) 

END;  <*  End  o^  INVERT  *) 


« ) 


(•«•••«•*••««••*••••••••••••«••••<«<•••••«•«•«««•«•««*««••*«*•*«•«*• ) 

PROCEDURE  PREPTOEIG; 

(•«*•*••««*«***•••«•«««•*•*«•««••••••»•**•••••«««•««««««•«*•«•*••••«) 

<♦  * ) 

<*  This  procedure  generates  matrix  A,  From  which  the  *) 

<*  eigenvalues  are  calculated,  by  multiplying  the  *) 

<*  partitions  oF  the  Sample  Correlation  Matrix!  *) 

(«  *) 

<*  -1  -1  ♦) 
<*  A  ■  C  R<YY)  *  R(YX)  *  R<XX)  *  R(XY)  3  *) 

(♦  *) 

(«••«••«•«••«••«•••••••«•*•*••«••««•••••••••••«*••••«*««•••««•«««•««) 

VAR  I,J,l:  integer;  <*  iteration  counters  *) 

<•  Internal  Procedure  ♦) 

PROCEDURE  CLEAR (VAR  A: MATRIX);  (*  Empty  matrix  A  «) 


BEGIN 

FOR  l:=l  TO  MAXSIZE  DO 

FOR  J:=1  to  MAXSIZE  DO 
ACI,J3:=0.0; 

END; 


< 


) 


procedure  GETUPPERLEFT; 


BEGIN 

FOR  I:«l  TO  P  DO  <*  Get  R(YY)'  a  R(YX)  *) 

FOR  j:=i  to  K  DO 

FOR  L:»1  to  P  do 

ACI,J3:«ACI,J3+(CMCI,L3*CMCL, (J+P) 3); 

FOB  1 1*!  TO  P  DO 

FOR  J:-1  to  K  DO 

CMCI, (J+P) 3:*ACI,J3; 
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CLEAR (A) ; 

END; 


< 


) 


PROCEDURE  GETLOWERRIGHT; 


BEGIN 

FOR  l:«l  TO  K  DO  <*  Get  R(XX)’  *R(XV)  •) 

FOR  J: =I  TO  P  DO 

FOR  l:=i  to  K  DO 

ACl,JD:=Ari, J3+ 

(CMC ( I»P) , <L*P) I«CMC (L*P) , JD ) ; 


FOR  l:=l  TO  K  DO 

FOR  j:«=i  to  p  do 

CMC  <1+P),J3:=AC1,JD; 
CLEAR (A) ; 

END; 


< 


) 


PROCEDURE  BETMATRIXA; 

BEGIN 

FOR  l:=l  TO  P  DO 

FOR  j:»=i  to  p  do 

FOR  l;=i  to  k  do 

ACI,  J3:=ACI,  J3-KCMCI,  (L+P)  3*CMC  (Lt-P)  ,03)  ; 

end; 


<*  Main  body  o-f  PREPTOEIG  *) 


BEGIN 

FE AS: 'TRUE; 

FOR  l:»l  TO  P  DO  (*  Bet  R(YY)’  *) 

FOR  J;'l  TO  P  DO 

ACI,J3:=CMCI,J3; 

INVERT<P,FEAS,A,A) ; 

IF  (FEAS)  THEN  (*  Proceed  if  •feasablc  *) 

BEGIN 

FOR  l;-l  TO  P  DO 

FOR  Jl'l  TO  P  DO 

Cliri,  J3:'AII,  J3| 

CLEAR (A) ; 

FDR  l:'l  TO  K  DO  (*  Bet  R(XX)’  *> 

FOR  J:=l  TO  K  DO 

AC  I, J3:-CMC (I*P> ,  (J*P) 3; 

INVERT (K, FEAS, A, A) I 


IF  <FEAS)  THEN 
BEBIN 


(*  Proceed  if  feaaable  •) 


FOR  l;=l  TO  K  DO 

FOR  J:=l  TO  K  DO 

CMC  <i+P) , (J*P) 3: =AC I , J]; 

CLEAR <A) ; 

GETUPPERLEFT; 

GETLOWERRIGHT; 

getmatrixa; 

END;  <*  End  oT  2nd  FEABability  check  *) 
END;  <*  End  o-f  1st  FEASability  check  *) 

END;  (*  End  o-f  PREPare  TO  ElGen  *) 


PROCEDURE  eigen; 

<«  •> 

(*  This  procedure  needs  as  input:  ■•) 

<*  *) 

<*  N  -  Order  o-f  tnatrix  to  be  solved  *) 

<*  A(N,N)  -  Matrix  to  -find  eigenvalues  o-f 

<*  *) 

<•*  This  procedure  returns  as  output:  *) 

<•  *> 

<*  E<N)  -  Eigenvalues  in  decreasing  order  *) 

<*  V<N,N)  -  Associated  eigenvectors  *) 

<*  *) 

(••••«•«•««««••«•••««•«*•••«•••••••••««*•••••••••••*«••*••••**••••««) 

VAR 

UR,  (a  Top  roM  o-f  deflated  matrices  •> 

Z:  (•  Eigenvectors  of  deflated  matrices  •> 

MATRIX  5 

B,  <*  Current  eigenvector  •> 

c:  <•  Dot  product  of  A(N,N>  and  B(N)  •> 

VECTOR: 

I,J,  <*  Iteration  counters  *) 

L,  <•  Eigenvalue  counter  *) 

NS:  <*  Top  row/Left  col  of  deflated  matrix  *1 

INTEGER; 

VALUE,  (•  Current  estimation  of  eigenvalue  •) 

LAST,  (a  Previous  estimation  of  eigenvalue  •) 

EPS,  (a  Accuracy  stopping  criteria  *) 

SCALE:  <a  Eigenvector  scale  factor  *) 

REAL; 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

(a  Internal  Procedures  a) 

(saaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

PROCEDURE  initialize; 

BEGIN  <a  Initialize  matrices  •) 


FOR  l:-l  TO  N  DO 
BEGIN 
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FOR  j:=i  to  n  do 
BEGIN 

v[i,Ji:=o.o; 

URtl,J3:=o.o; 

Ztl, J3:=o.o; 

END; 

BCn:«=0.0; 

URC 1 ,  n:=At  1, 13; 

END; 

B:n:  =  i.o; 

END;  («  End  o-f  INITIALIZE  *) 

(••••••««•••»•*••«••«•««••»•••••«••••••««•••••«•«•••••••••••*•««*«••) 

PROCEDURE  BETEPS; 


VAR  0PT1,0PT2,0PT3:  CHAR; 

(* 

Menu  options 

«) 

BEGIN 

0PT2:=’ Y’ ; 

(• 

Get  stopping 

val  ue 

*) 

(*SI-*) 

(* 

Turn  ott  I/O 

check 

*) 

GOTOXY (0,6) ; 

WRlTELN(’Do  you  desire  optional  precision  setting'’’); 
WRITElN;'  (More  precision  requires  more  time)’); 

WHILE  (0PT2=’Y’)  OR  (OPT2=’y’)  DO 
BEGIN 

GOTOXYiO, 10) ; 

WRITELN < ' Sel ect  desired  optirn:’); 

WRITELNC  1  -  Enter  desired  EPSILON 

'value'  > ; 

WRITELNC  2  -  Go  with  de'faolt  o^f  0.0001’); 

GETOPTION(OPTI); 

WHILE  lOPTlO’l')  AND  (OPTIO’2’)  DO 
GETOPTION(OPTI)  ; 

IF  <0PT1«’1’)  THEN 
BEGIN 

ERASE <10, 3) ; 

GOTOXYCO, 10) ; 

WRITELN (’Enter  desired  EPSILON  value:’); 
WRITELN<CHR(7) ) ; 

RESET (INPUT) ; 

READ (EPS) ; 

WHILE  (IDRESULT»=14)  OR  (EPS>0,  1)  OR 
<EPB<0. 000001)  DO 
BEGIN 

B0T0XY(1,20) ; 

WRITE (CHR( 15) , 'WARNING: ’ , 

CHR(14) , '  bust  be  ' , 
'between  .OOOOOl 
'end  .1.  Press  any 
'key  to  try  again.'); 
BDTDXY(0,20) ; 

BET0PTI0N(0PT3) ; 

ERASE (12, 11); 

B0T0XY(0, 12) ; 

RESET (INPUT) ; 

READ (EPS) J 
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EPS: =0.0001 


GOToxv (0, 10) ; 

WRITELNC EPSILON  setting  iE’,EPS:9:6, 

'  between  j t t rat i one , ' ) ; 

WRITELNC’  ':40); 

WRITELN(’Do  you  want  to  make  a  change"’’,'  ':10); 
WRITELNC'  Y  -  Yes,  go  back  and  change  it’); 
WRITELN('  N  -  No,  Stay  with  this  value’); 
GET0PTI0N(0PT2)  ; 

WHILE  <0PT2<>'Y’)  AND  <0PT2<>’N’)  AND 
<0PT2<>’y’)  AND  (0PT2<>’n’)  DO 
GET0PTI0N(0PT2) J 
ERASE <10,5) ; 

END;  <*  End  of  WHILE  loop  •) 

(•SI-*-*)  (•  Turn  on  I/O  checking  *) 

ERASE  <&,2) ; 

END;  (*  End  o-f  GET  EPSilon  *) 


( 


) 


PROCEDURE  PREPARE; 

FUNCTION  MAX  (A,B:REAL)  :REAL;  <*  Get  max  o-f  +  set  -from  lero  •) 
BEGIN 

IF  (ABS<A) >ABS<B) )  THEN 
MAX:=A 

ELSE 

MAX:=B; 

END;  <*  End  o-f  MAX  *) 

BEGIN  (*  Prepare  to  get  eigenvalue  *) 

SCALE; =0.0 ; 

FOR  l;-NS  TO  N  DO 
BEGIN 

Ct  n;=0.0; 

FOR  J:»NS  TO  N  DO 

ccn:=ccn+Aii,jD*BCj:; 

scale: -MAX (BCALE.Cri 3) f 

END; 

FOR  I:-NS  TO  N  DO 

IF  <SCALE=0.0)  THEN 
CCI3:-0.0 

ELSE 

CtI3:-CCI3/SCALE; 

END;  (•  End  o-f  PREPARE  to  get  eigenvalue  •> 


< 


) 


PROCEDURE  GETEIGEN; 

VAR  x,y;  real; 

BEGIN  (•  Estimate  eigenvalue  •) 


IF  (X=0.0)  THEN 

VALUE; =99. 9999 

ELSE 

VALUE: =SCALE*  <Y/X) ; 

IF  <VALUE<0.0)  THEN 
VALUE; =0. 0; 

END;  <*  End  o-f  GET  EIGENvalue  *) 


PROCEDURE  getnewvector; 

VAR  sum.t:  real; 

BEGIN  (*  Eigenvectort  o-f  original  * 

ECL];«VALUE; 

FOR  I:=NS  TO  N  DO 

IF  <BCNS]=0.0)  THEN 

ctn:«o.o 

ELSE 

ccni'Bcn/BCNSi; 

FOR  I;»(L-1)  DOWNTO  1  DO 
BEGIN 

SUM:=0.0; 

FOR  J;=l  TO  N  DO 

BUn;=SUM-t-URC  I ,  J3*BC  J3? 

IF  <SUM<>0.0)  THEN 
BEGIN 

T:  •=  <VALUE-EC  I  3  )  /SUM; 

FOR  J:»l  TO  N  DO 

BCJ3:-ZC1, J3+T*BCJ3; 

END; 

END; 

FOR  l;-l  TO  N  DO 

IF  <ECL3-0.0)  OR  (EtL3»99. 9999)  THEN 
VtI,L3:-99.9999 

ELSE 

V:i,L3;-BCI3; 

END;  <*  End  o-f  BET  NEW  VECTOR  •> 


PROCEDURE  REDUCEMATRIX; 


VAR  df:  matrix; 


BEGIN  (•  Deflate  original  matrix  a) 

FOR  I ; =NS  TO  N  DO 

FOR  j:=ns  to  n  do 

DFCI.J];=CC13«A[NS, J3; 

FOR  I:-NS  TO  N  DO 

FOR  J:»=NS  TO  N  DO 

At  1 , J3;=AC 1 , J3-DF[ 1 , JI; 


NS:=NS+l; 

FOR  1:«NS  TO  N  DO 

URtNS, 13:=AtNS, 13; 

FOR  l:*l  TO  <NS-1)  DO 
BCi3:-o.o; 

BCNS3:=l.O; 

end;  <*  End  o-f  REDUCE  MATRIX  a) 


) 


FUNCTION  DONE (A,B,EPS:REAL) :boolean; 
BEGIN 

DONE:=(ABS<A-B)  <=  EPS); 

end; 


(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 
<a  Main  body  O'f  EIGEN  procedure  a) 
(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 


BEGIN 

INITIALIZE; 

NS:=i ; 

GETEPS; 

FOR  L!*!  TO  N  DO  (a  Get  each  eigenvalue  *) 

BEGIN 

LAST; *0.0; 

VALUE: =n; 

WHILE  NOT (DONE (LAST, VALUE, EPS) )  DC 
BEGIN 

LAST; -VALUE; 

PREPARE; 

BETEIGEN; 

FOR  I:-NS  TO  N  DO  (a  Beale  vector  *1 

IF  (CtNSD-0.0)  THEN 
B[I3:-0.0 

ELSE 

Bin;-Ctl3/ctNS3; 

END;  (a  End  o4  WHILE  loop  a) 


FOR  l;-l  TO  N  DO 
ZCL,13:-BCI3; 


(a  Save  each  eigenvector  •) 


GETNEWVECTOR; 

IF  <L<N)  THEN 

REDUCEMATRIX; 

END;  <*  End  o-f  Each  Eigenvalue  «) 

END;  <*  End  O'f  get  EIGENvalue  *) 

(*  Initialization  part  ot  UNIT  * 


<**S+*) 


UNIT  riu_l;  INTRINSIC  CODE  19; 

INTERFACE 

USES  TRANSCEND,  APPLESTUFF,  MAIN_UN1T; 

PROCEDURE  USERSELECT (VAR  N, NS: INTEGER) ; 

PROCEDURE  BARTLETT (VAR  N, NS, NUMREC : INTEGER ; VAR  E I GVAL : VECTOR ) ; 

PROCEDURE  SCREE (VAR  N, NS: INTEGER;  VAR  E I GVAL :  VECTOR )  ; 

PROCEDURE  SELECTFACTORS (VAR  NS, NUMREC: I NTEGER : VAR  E I GVAL : VECTOR : 

VAR  GROUP :HEADER2; PRINTER: BOOLEAN) ; 


implementation 


(•«••»••*••••*»•••••*••«••«••••••••••••••«•«••••••«•••«•••••*•*•««•«) 

<*  Main  pant  o-f  MU_  I  ♦) 

PROCEDURE  USERSELECT; 

(*  *) 

(*  This  procedure  asks  the  user  the  number  o-f  available  *) 

<♦  -factors  that  should  be  kept  for  analysis.  *) 

<•  *) 

VAR  OPT:  CHAR;  (•  Menu  option  *) 


BEGIN 

<**I-«) 

GOTOXY (0, IB) ; 

WRITELN(CHR (7) , ’Enter  number  of  factors  (1-’,N,’)  to 
’ keep: ’ ,CHR ( 13) ) ; 

RESET (INPUT)  ; 

READ (NS) ; 

WHILE  ( IORESULT-14)  OR  (NS<1)  OR  (NS>N)  DO 
BEGIN 

GOTOXY (1,21)1 

WRITELN(CHR (15) , ’WARNING: ’ , CHR ( 14) , 

’  Must  keep  at  least  1  and  no  more  ’, 
’than  ’,N, ’  factors.'); 

WR1TELN(’  ’Ill, ’Press  any  key  to  try  again’); 
GOTOXY (0,21 ) ; 

GETOPTION(OPT) ; 

ERASE (20,3) 1 
BOT0XY(0,20) ; 

RESET (INPUT) ; 

READ (NS) ; 

END;  (•  End  of  Bad  number  of  factors  *) 

ERASE (IB, 3); 

(•SI-*-*) 

END;  (*  End  of  USER  SELECT  *) 


PROCEDURE  BARTLETT! 


(•••«••••*••••«««»«••»«««•••••••••*••••*••««»««««««««••*««•«««*•««••) 

(*  *) 

<*  This  procedure  calculates  the  CHI-Square  statistic  *) 

(*  -for  the  Bartlett  test  o-f  significance  for  as  •) 

(a  many  of  the  factors  as  the  user  desires.  The  *) 

(a  user  is  then  asked  to  select  the  number  of  *) 

(a  significant  factors  to  keep  for  FACTOR  analysis.  ♦) 

(a  a ) 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa***) 

VAR 

I,  (a  Iteration  counter  a) 

INDEX,  <a  Non-zero  factors  *) 

row:  <a  Row  on  screen  a) 

INTEGER; 


R,W,  (a  Parts  of  the  statistic  a) 

MULTI,  (a  Statistical  multipliers  a) 


MULT2, 

6TAT;  <a  Bartlett  statistic  a) 

REAL! 

OPT;  <a  Menu  option  a) 

CHAR; 

DONE:  (a  Completion  indicator  a) 

BOOLEAN! 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

<a  Internal  procedures  a) 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 


PROCEDURE  INSTRUCTUSER; 

BEGIN 

WRITE (CHR ( 12) ) ; 

GOTOXY (26,1)! 

WRITELN(CHR ( 15) , '  BARTLETT  SPHERICITY  TEST  ’,CHR(14))! 
GOTOXY (0,4) ! 

WRITELN ( ’ Thi s  test  c  Iculates  a  CHI-Square  test 

'statistic  to  check  the  hypothesi s; ' , CHR ( 13) ) ! 
WRITELN(’  Ho:  EIGVAL <r+l ) -EIGVAL (r+2) , 

'EIGVAL(K)«0’ ) ! 

WRITELNC  vs.')! 

WRITELNC  Ha:  EIGVAL(r  +  I>  <>  0!  after  "r"'  tests’)! 

WRITELN! 

WRITELNC You  should  reference  a  CHI-Square  table  for’)! 
WRITELN! 

WRITELN(’  CHI  C  a  ,  <k-r)<k-r-l)  3,  at  level  a’ ) i 

WRITELN! 

WRITELN (’ Thi s  routine  calculates  one  test  statistic,  ', 
'then  asks  if  you  wish  to  continue.’)! 
WRITELN(’You  must  decide  when  to  stop.  It  will  ’, 

'stop  automatically  after  calculating’)! 
WR1TELN(N,’  values.  You  will  then  be  asked  to  select  ', 
'the  number  of  factors  to  keep . ' , CHR ( 13) ) ! 

WRITELN C NOTE:  This  test  is  good  for  small  samples  ', 

' (n  <  100)  or  for  a  large')! 

WRITELN!'  number  of  manifestation  variables  ', 
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•  <k  >  9> . • )  I 
GDT0XY(22,22) ; 

WRlTE(’Pr»s»  ary  k*y  to  start  routine 
BETOPTION(OPT) ; 

ERASE (4, 19> ; 

!  <*  End  o+  INSTRUCT  USER  *) 


FUNCTION  DIVISOR <R: INTEGER; :REAL; 


VAR  TEMP1,TEMP2:REALI 


(•  Temporary  variables  *) 


BEGIN 

TEMPI .0; 

TEMP2:«f;/  <N-R)  I 
FOR  ’•«!  TO  R  DO 

TEMP2: =TEMP2- (EIGVALI 13)/ <N-R) i 
FOR  l:*l  TO  <N-R)  DO 

TEMP 1 : -TEMP 1 *TEMP2 ; 

DIVISOR: -TEMPI  5 

END; 


Main  body  of  BARTLETT 


BEGIN 

(♦•R  TRANSCEND  *)  <#  Re 

R;-1.0I  <*  In 

done: -false; 

multi;  — (NUMREC  -  I  -  <2aN*5) /6. 0) ; 
MULT2;  — <  <NUMREC+1)  -  <2*N+5) /6. 0) ; 

instructuber; 


FOR  INDEX :-l  TO  N  DO 

R : -R*E I GVAL  C I NDE  X  3 ; 

W:-R; 

IF  (W-0.0)  THEN 
8TAT:-99.9999 

ELBE 

STAT;-MULT1*LN(W) I 


<a  Retain  UNIT  in  memory 
<a  Initialize  parameters 


<•  Calculate  1st  statistic 


80T0Xy(0,8) ; 

WRITELNC Overall  Statistic  -  ’,BTAT:7:4); 

INDEX :-o; 

WHILE  NOT (DONE)  DO  <•  Get  sequential  statistics  •) 

BEGIN 

B0T0XY<0,20)| 

MRlTELNCGelect  desired  option:’); 

MR1TELN(*  I  -  Continue  Mith  sequential 

’test(s>'>l 

HR1TELN(’  2  -  Em  it  ti  Choose  number  of  ’t 

’^actors’); 

BETOPTIONiOPT); 

WHILE  (OPTO’l’)  AND  (OPTO’2’)  DO 


SET0P710N(0PT); 

ERASE (20, 3>: 

R0W:-INDEX-»10; 

BOTOXV (0,R0M) ; 

IF  (OPT* *2*)  THEN 
D0ne:«true; 

IF  NOT (DONE)  THEN 
BEGIN 

INDEX;xINDEX*i; 

R:>R/E1GVALC INDEX]; 

N:-R/DIVISOR(INDEX) ; 

BT AT : -MULT2*LN ( W  >  ; 

WRITELNC  With  ’.INDEX,’  non-2»ro  -  ’, 
BTAT:7:4> ; 

END; 

IF  (INDEX*N-1)  TI«N 

done:* true; 

END;  (•  End  o4  Bcqutntial  t»ct  •) 


USERBELECT(N,NS) ; 

END;  (•  End  of  BARTLETT  •> 


(•  Get  number  of  Factors  •) 


PROCED(JRE  scree; 


Thie  procedure  displays  instructions  on  how  to  select 
the  number  oF  Factors  to  keep  based  on  a  plot  oF 
Eigenvalue  Magnitude  and  Factor  Number.  The 
user  is  then  shown  the  plot  and  asked  to  select 
the  number  (NS)  of  slgniFicant  Factors  to  keep. 


INDEX, 

(a 

Index  into  EIGVAL  array 

a) 

I, 

(a 

Iteration  counter 

a) 

PITCH, 

(a 

Bound  used  in  curve  plot 

a) 

ROM, 

(a 

Row  For  data  display 

a) 

COL, 

(a 

Column  For  data  display 

a) 

x,y; 

(a 

Positions  on  text  screen 

a) 

integer; 

value: 

(a 

Eigenvalue  being  plotted 

a) 

REAL! 

OPT: 

(a 

Menu  option 

a) 

CHARI 

LETTER: 

(a 

Used  in  printing  the  labels 

a) 

string; 

(••eaeeaasaaaeaeseeeeeeesaaaseeesaaeseeaaaaeseeesaasaseeseeeeesesaaa) 
(a  Internal  Procedures  •> 
(eeseeeaseaaaeeeseaeseeaeeeaaaaesaesseaasaesseaessseseeaaseeassaaaaa) 


PROCEDURE  DRAMAXISi 


BEGIN 

FOR  Y:bO  to  22  DO  (•  Vertical  Axis  •) 

BEGIN 

S0T0Xy<10,V)} 

WRITE <CHR< 15),’  ’,CHR(14)>; 

END; 

FOR  X:“B  TO  52  DO  <•  Horizontal  Axis  •) 

BEGIN 

G0T0XY<X,21> ; 

WRITE (CHR( 15), ’  •,CHR<14)); 

END; 

FOR  X:>50  DOWNTO  14  DO  (•  Horizontal  hash  marks  •> 

IF  <<X-14)  MOD  4-0)  THEN 
BEGIN 

60T0XY(X,21)1 
WRITEC  ’)J 

end; 

FOR  Y:-21  DOWNTO  1  DO  <a  Vertical  hash  marks  •) 

IF  <<y-l)  MOD  2  «  O)  THEN 
BEGIN 

B0T0XY<10,Y)5 
WRITEC  ’)! 

ENDS 

END;  <a  End  04  DRAW  AXIS  •> 

<•*•*•#••#**•»»••*#••#*•##••••*»##•#»••••#••##•#•##•*•#**###•••#••##) 

PROCEDURE  LABELAXIS: 


BEGIN 

IF  (N>5>  THEN  C#  Vortical  seal*:  Comprossed  •> 

BEGIN 

R0W:>10| 

FOR  Yl-l  TO  19  DO 

IF  <<Y-1)  MOD  2  ■  0)  THEN 
BEGIN 

B0T0XY(7,V)I 
WRITE (ROW: 2) I 
ROW: -ROW- It 

END  I 

END 

ELSE 

BEGIN  (*  Vortical  ocalo:  Expandod  •) 

row: -SI 

FOR  V;-l  TO  19  DO 

IF  MOD  4-0)  THEN 

BEGIN 

00T0XV<7,V>I 
WRITE (ROW: 2) I 
row: -ROW- It 

END  I 

ENDl  (•  End  o4  Vortical  Scalo  •> 


IF  (N>8>  THEN 
BEGIN 


<a  Horizontal  ocalo:  Ce(M>rooood  a) 


FOR  X:«14  TO  50  DO 

IF  <<X-14)  MOD  4*0)  THEN 
BEGIN 

G0T0XY<X,22) ; 

write<col:2) ; 
col:«col*i; 

end; 


BEGIN  (•  Horizonta 

COL:*i; 

FOR  X:«14  TO  50  DO 

IF  ((X-18)  MOD  6*0)  THEN 
BEGIN 

G0T0XY<X,22) ; 
MRITE<C0L:2) : 

col:*col+i; 

end; 

end;  (•  End  cf  Horizontal  scale  •) 


(•  Horizontal  scale:  Expanded  •) 


y;*o; 

for  l:*l  TO  11  DO  (•  Vertical  label 

BEGIN 

LETTER : *COP Y  < ’ E 1 GENVALUES ’  ,1,1)1 
G0T0XY<3,Y)1 
WRITE (LETTER) 1 

y;*y-*-2i 

end; 


x;*2i; 

FOR  l;-l  TO  7  DO  <•  Horizo 

BEGIN 

LETTER : -COPY ( ' FACTORS ’,1,1)1 
e0T0XY<X,23>; 

WRITE (LETTER) 1 

x;*x*4i 

END; 

END;  <•  End  Of  LABEL  AXIS  •) 


(•  Horizontal  label 


PROCEDURE  PLOTPOINTSl 


BEGIN 

(••R  APPLE6TUFF  e) 


(•  Retain  sound  UNIT  in  aiemory  *) 


FOR  index: -1  TO  N  DO  <« 

BEGIN 

VALUE :  *E  I GV  AL 1 1 NDE  X  3 ; 


<«  Plot  the  points 


IF  <N>5)  THEN 
BEGIN 

row: -ROIMD (2»VALUE )  ( 
X:-ll  *  (INDEX  •  4)1 

END 

ELSE 

BEGIN 

R0W:-R0UND(4eVALUE) ( 
x:>ll  *  (INDEX  •  6>t 


END  I 

y:»21  -  row; 

PITCH:*31  -  Y? 

BOTOXY(X,Y); 

WRITE<CHR<15),’*’,CHR(14) >; 
NOTE (PITCH, 10) I 

END; 

END;  <•  End  0+  PLOT  POINTS  ♦) 


PROCEDURE  SHOW INSTRUCT IONS; 

BEGIN 

MRITELNCWhan  you  arc  r  1y,  you  Mill  b*  shown  a  plot  of 
’Eiganvalua  Magr. ;udas  va. ' > ; 

WR I TELN (’ Factor  Nunbara.  You  will  ba  aakad  to 
’viaualiza  a  lina  paaaing  through’); 

WRITELNCtha  right  most  points  and  SMtanding  to  the  la'ft.’); 
MRITELN; 

MRlTELNCTha  most  aigni'ficant  'factors  are  those  that  do 
CHR(lS),’not’,CHR(14),*  fall  on  that  lina 
CHR<15),’plus’,CHR<14))) 

WRITELN('tha  first  ona  that  does.  That  is  the  number  of 
’factors  you  should  keep.’); 

60T0XY(22,22); 

WRITE < ’Press  any  key  to  sea  the  plot  ’)! 
end;  (a  End  of  SHOW  INSTRUCTIONS  •) 


<a  Hain  body  of  SCREE  routine  •) 


BEGIN 

(•«!-«) 

WRITELN<CHR(12),’  ’ !55,CHR < 15) , ’  SCREE  TEST  ’,CHR(14)>1 
e0T0XY(0,S)| 

SHOW INSTRUCT IONS; 

eETOPTlON(OPT) I 
ERASE (5, 6) I 
ERASE(22, 1) I 

ORAWAXIS) 

LABELAXISI 

PLOTPOINTS; 

BOTOXY<37,8)  I 

WRITE (’Visualize  a  ’’scree  lina”  through’); 
B0T0XY<37,9); 

WRlTEl’tha  right-most  points.  Enter  the’); 

B0T0XY(37, 10) I 

WRITE (’number  of  points  not  on  that’) I 
e0T0XY(37,li)| 

WRITE(’llne  ’ ,CHR( 15) , 'plus’ ,CHR( 14) , ’  1:  ’,CHR(7))| 


RESET(INPUT) I 


READ (NS) ; 


WHILE  ( I0RESULT>14)  OR  (NS<1)  OR  (N5>N>  DO 
BEGIN 

e0T0XV<37, lA) ; 

HRITEC  • ,CHR(15> , 'WARNING:  ’  ,CHR( 1A>  ,  ’  Mu»t  be 
’at  least  1  and')S 
B0T0XY<47,15> J 

WRITE (’no  more  than  ’,N,’  factors.’); 

G0T0XY(47, 17)  I 

WRITE(’PresB  any  key  to  try  again’); 

S0T0XY(37,14); 

BETDPTION(OPT) ; 

G0T0XY(50,11)1 
WRITEC  ’:20); 

FOR  l:«l  TO  4  DO 
BEGIN 

G0T0XY(37, <l+13) ) ; 

WRITE <’  ’:36); 

END; 

Q0T0XY<50,  11); 

RESET (INPUT); 

READ (NS) ; 

ENDS  (a  End  of  Bad  number  of  factors  •) 

(asi**) 

end;  (a  End  of  SCREE  test  a) 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaeaasaasaaaa*.*) 


PROCEDURE  SELECTFACTORS; 


^aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaeaaeaaaaaaaaaaaaaaaaaaasaaaeaaaaaa) 

a) 

This  procedure  calculates  and  prints  the  percents  of  *> 
variance  explained  by  each  factor,  and  then  has  a) 
the  user  select  the  number  of  factors  <NS)  to  a) 

maintain.  Selection  is  done  by  one  of  these:  a) 

a) 

1  -  Default  (Eigenvalues  >  1.0)  a) 

2  -  Scree  Test  a) 

3  -  Bartlett’s  Sphericity  Test  a) 

4  -  User  select  a) 

a) 

)aaaaaaaaaa#as»aaaaaaaaaaaaaasaaaaaaaaaaaasaaaaaeaaaaaaaaaaaaa*aa) 

VAR 

X,J,  (a  Iteration  counters  a) 

N:  (a  Number  of  factors  a) 

INTEGER; 

VALUE,  (a  Eigenvalue  a) 

PCTOFVAR,  (a  Percent  of  variance  a) 

CUNPCT:  (a  Cumulative  percent  a) 

REAL  I 

OPT,  (a  Menu  options  ♦) 

OPTi: 

CHARI 


(eaeeaaaaaaaaaeaaaaaaaaaaaaaaaaaa-saaaaaaaasaaasaaaaaaaaaaaaaaaaaaaaa) 


m 

s’ 

<y,< 

H 


V’.-. 


f.  !■.■.■.  ly.  A'  yjp;  k  >».' J.  •■  J.  'J  ■>  ■ 


'>  •>  '•>  •  •  ^ 


*CUH  PCT’ :  10,CHR(14)  ,CHP!(13)  )  ; 


IF  (PRINTER)  THEN 

WRITELN(PTR,'FRCTOR’, ‘EIGENVALUE’:  13, 'PCT  OF  VAR’: 13, 
‘CUM  PCT’ : 10,CHR(13) > } 

BETNPRINTSTATS; 


V  'J 


G0T0)(Y(0,  IB)  ; 

WRlTELNCPick  dcsirad  m»thod  of  FACTOR  selection:’); 

WRITELNC’  1  -  Eigenvalues  >  1.0’); 

WRITELN(’  2  -  Scree  Test’); 

MR1TELN<’  3  -  Bartletf’s  Sphericity  Test’); 

WR1TELN<’  4  -  User  selection’); 

SET0PTI0N<0PT) ; 

WHILE  <0PT<’1’)  OR  <0PT>’4’)  DO 
GETOPTION(OFT) ; 

ERASE (18, S); 

CASE  (OPT)  OF  <•  Bet  significant  factors  *) 

'1':  FOR  Ifl  TO  N  DO 

IF  (EIGVALtI3>1.0>  THEN 
NS:«NS-»-i; 

’2’:  SCREE  (N,  NS, EIBVAD; 

' 3 • ;  BARTLETT ( N, NS , NUMREC, E I SVAL  > 1 
'4’;  USERSELECT(N,NS); 

END;  <•  End  of  CASE  •) 


RECAPSELECTION; 

60T0XY(0,22) ; 

WRITE (’Press  any  key  to  continue  FACTOR  analysis  ’>; 
BET0PTI0N(0PT1>; 

6R0UPC-13:-NS; 

WR1TELN(CHR(12),'  ' ;26,CHR ( 15) , '  FACTOR  ANALYSIS  ROUTINE 
CHR(14))| 

END;  <•  End  of  SELECT  FACTORS  •) 


(#« 

(e 

<•« 


Initialisation  part  of  UNIT 


*•> 

*) 

»•) 


END. 
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(**S+*> 


UNIT  nu.j;  INTRINSIC  CODE  20: 

INTERFACE 

USES  TRANSCEND,  MAIN_UNIT,  MU_E: 

PROCEDURE  GETCVSS(VAR  DATA: RAWDATA; VAR  GROUP: HE ADER2; 

VAR  ALPHA, BETA:«ATRIX;NUMREC, width: INTEGER; 
PRINTER: BOOLEAN) ; 

PROCEDURE  STRUCTURECORR (VAR  ALPHA, BETA, CM: MATRI X ; VAR  EIGVAL: VECTOR 

VAR  SPECS 1 : HEADER 1 ; VAR  GROUP ; HEADER2 ; 
WIDTH: INTEGER; PRINTER: BOOLEAN) ; 

IMPLEMENTATION 

<*  M«in  body  o-f  MU  J  *) 

(••••••••••••••••••••••••••*•••••••••••••••••»•••••»••••»•••«••«*•••) 

PROCEDURE  GETCVSS: 

(•••••••••••••••••••••••••••••••••••»•••••••••••••••••••••«••••««••«) 

<•  •> 

<•  This  procsdur*  calculates  the  Canonical  Variate  •) 

(•  scores  and  then  prints  and/or  saves  them,  •> 

<•  as  desired.  •> 

<*  a) 

<a  Y*  -  (V)  a  Alpha  Xa  -  (X)  a  Beta  a) 

<a  a) 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

VAR 

I,J,L,  <a  Iteration  counters  a) 

INDEX,  (a  Sorter  Ic  Eigen  counter  a) 

P,  <a  Number  of  criterions  a) 

K,  (a  Number  predictors  a) 

N,  (a  Lessor  04  P  and  K  a) 

X,  (a  Index  o4  Xa  in  SCORES  a) 

V:  (a  Index  o4  Ya  in  SCORES  a) 

INTEGER; 

6PCS1:  (a  Field  names  o4  saved  SCORES  a) 

HEADERi; 

A,  <a  Sorted  pointer  array  a) 

8PCS2:  (a  Field  Nidths  o4  saved  SCORES  a) 

HEADER21 

OPTl,  <•  Menu  options  *> 

0PT2: 

CHARI 

FIELD:  (a  Field  number  identifier  a) 

STRING I 

<saaa#aaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa> 
<a  Internal  Procedures  •> 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

PROCEDURE  CALCTHEVALUESI 

BEGIN 
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FOR  INDEX :>1  TO  N  DO  <•  Calculata  C«n  Var  scor**  •) 

FOR  L:b1  to  NUNREC  do  (•  For  aach  aiganvalu*  •) 
BEGIN 

X:-2aINDEX; 

y:-x-ii 

8COREBCL,Y3:*O.Ot  (•  Bat  Y«  •) 

FOR  J;«l  TO  P  DO 

IF  (ALPHA! J, 1NDEX3-99. 9999)  THEN 
SCORES ! L , Y  3 : -99 .9999 

ELSE 

IF  <BCDRESrL,Y3<>99.9999)  THEN 
SCORES  !  L ,  Y  3 : -SCORES  C  L ,  Y  3 

DATAtL,ACJ33«ALPHACJ,INDEX3; 

BCORESCL,X3:-O.Ot  (a  Gat  X«  a) 

FOR  J:-l  TO  K  DO 

IF  (BETAtJ, INDEX 3-99. 9999)  THEN 
SCORES! L, X  3 : -99.9999 

ELSE 

IF  (SC0RESIL,X3<>99.9999)  THEN 
SCORES  !  L  ,  X  3 : -SCORES  !  L ,  X  3 

DATA!L,A! (PaJ) 33aBETA! J, INDEX3I 

END! 

ENDI  (a  End  of  CALCulata  THE  VALuaS  a) 


<  aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa« 


PROCEDURE  PRlNTTHEVALUESt 
BEGIN 

e0T0XY(B,3)f 

WRIT£LN(CHR(1S>,'  CANONICAL  VARIATE  SCORES  ’,CHR(14)>| 
e0T0XY(2,9)| 


FOR  Z:-l  TO  N  DO 

WRITE ( ’ CANVAR' : 13, X : 2) I 
e0T0XY(9,6)| 

FOR  l:-l  TO  N  DO 

NRITECFirat  S«:ond':l5)| 
MRITELN(CHR(13>)I 


(a  Diaplay  haadara 


IF  (PRINTER)  TfCN  (a  Prlntar  haadars 

BEBIN 

NRITELN<PTR, 'CANONICAL  VARIATE  SCORES:’)! 
WRITE (PTR,CHR( 13),'  ’>! 

FOR  Z:-l  TO  N  DO 

WRITE (PTR, ’ CANVAR’ : 13, I : 2) I 
WRITE <PTR,CHR( 13),’  ':9)! 

FOR  l:-l  TO  N  DO 

WRITE (PTR, 'Firat  Bacond’:lS)| 
WRITELN(PTR,CHR(13) ) I 


FOR  L:-l  TO  NURREC  DO  (a  Diaplay  valuaa 

BEBIN 

IF  ((L  >  1)  AND  (L  NOD  13  -  1))  THEN 

BEBIN  (a  Pauaa  at  paga  and 

a0T0XY(22,22) I 
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WRlTE(’PreBS  *ny  key  to  continue  ’)i 
GET0PT10N(0PT2) ; 

ERASE  <B, 15> ; 

G0T0XY(0,8) ; 

END:  <*  End  of  Peuse  •) 

WRITE(L:3,'  '>: 

POR  1NDEX;=1  TO  N  DO 
BEGIN 

x:=2*iNDEx; 

v:=x-i; 

WR1TE(SC0REBCL,VD:B:3,SC0RESCL, X3;7:3) ; 

END: 

WRITELN: 

IF  (PRINTER)  THEN  (•  Print  values  ♦) 

BEGIN 

write(ptr,l:3,  ’  ’); 

FOR  index; *1  TO  N  DO 
BEGIN 

X:>2*INDEX; 

y:*=x-i; 

WRITEiPTR.SCORESCL, Y3:B:3, 
BCORE5tU,X3:7;3>  : 

END: 

WR1TElN<PTR)  ; 

END; 

END;  <•  End  oF  Display  values  a) 

IF  (PRINTER)  THEN 

WRITELN(PTR,CHR(13) ) ; 

60T0XY(22,22) ; 

NRlTECOone.  Press  any  key  to  continue  '); 
BET0PTI0N(0PT2) ; 

ERASE (3, 21); 

END;  (a  End  o*  PRINT  THE  VALUES  a) 

aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaasaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

PROCEDURE  SAVETHE VALUES; 

BEGIN 

G0T0XY(0,5) ; 

WRITELN (’ Hake  sure  a  prefer mat ted  Data  disk  is  in 
’Drive  V2.  Press  any  key  to  continue’); 
BET0PT10N(0PT2) ; 

FOR  1NDEX;-1  TO  N  DO  (a  Set  field  names  a) 

BEGIN 

X:a2aINDEX; 

y:-x-ii 

field; "COPY ( ’ 1234567B9’ , INDEX, 1 ) I 
6PCBltY3;-CONCAT(’  YCV’, FIELD, ’  ’); 

8PCSltX3;-C0NCAT(’  XCV’, FIELD,’  '); 

END; 

a) 


SPCB2 C - 1 3 : mNUNREC ; 
8PC62[03:-2aN; 


(a  Set  file  specs 


FOR  INDEX:=l  TO  <2*N)  DO  <*  Set  -field  widths  *) 

SPCS2CINDEX3:=8; 

BAVEFILE ( SCORES, SPCS 1 ,SPCS2) ; 

END;  <*  End  o-f  SAVE  THE  VALUES  ♦) 


. . . . . 

<*  Ham  bod-y-  o-f  CVSS  routine  *) 

. . . 


BEGIN 

P; “GROUPC-1 3 ;  (*  Initialize  parameters  *) 

k:-GROupco3; 

IF  <P>K)  THEN 
N:»K 

ELSE 

N;-P; 

INDEX:=0; 

FOR  I:=l  TO  WIDTH  DO 

IF  (group: I  3  =  1)  THEN 
BEGIN 

index:  =  iNDEx-^i; 
a:index3:=i; 

end; 

FOR  l;»l  TO  WIDTH  DO 

IF  <GROUPCI3=2)  THEN  <*  Predictor  variable  •) 

BEGIN 

index: =INDEX+l; 

AtINDEX3;*=I; 

end; 

CALCTHEVALUES;  (*  Calculate  CV  Scores  a) 

ERASE (22,  1 )  i 

SDT0XY(0, IS)  I 

WRITELN ( * Sel ect  desired  option:’); 

MRITELNC  1  -  Print  ’.NUMREC,’  Canonical  Variate  ’, 

'Scores’ ) f 

WRITELN (’  2  -  Save  the  scores  to  disk’)| 

WRITELN(’  3  -  Do  both  Print  and  Save’); 

WRITELN (’  4  -  Do  nothing.  Proceed  to  Canonical  ’, 

'Loadings’ ) ; 

BET0PTI0N(0PT1 ) I 

WHILE  <0PT1<’1’)  OR  (0PTI>’4’)  DO 
BCTOPTION(OPTn  I 

ERASE (16,5) I 

IF  <0PT1-’1’)  OR  (0PTl-’3’)  THEN  (a  Print  all  the  values  a) 
PRINTTHEVALUES; 

IF  <0PTl-’2’)  OR  <0PTl-’3’>  TfCN  (a  Save  to  disk  a) 

SAVETHEVALUESI 


(a  Bet  sequential  pointers  a) 

(a  Criterion  variable  a) 


END;  (a  End  o-f  SET  Canonical  Variate  BcoreS  a) 


PROCEDURE  STRUCTURECORR; 


<*  *> 

(•  This  proodure  calculates  and  prints  the  Structure  a) 

<«  Correlations  and  the  IndeKes  oi  Redundancy  •) 

(•  based  on  the  Canonical  Variate  Coe4 'f i c i ents  •) 

(a  (Alpha  &  Beta),  the  Eigenvalues,  and  the  a) 

(a  Sample  Correlation  Matrix  (CM).  a) 

(a  a ) 

VAR 

(a  Iteration  counters  a) 

INDEX,  (a  Index  into  arrays  a) 

P,  (a  Number  o-f  cr  iter  ions  a) 

K,  (a  Number  oi  predictors  a) 

N,  (a  Lesser  ot  P  and  K  a) 

row:  (a  Rom  on  screen  a) 

INTEGER; 

RVSQ,  (a  Total  variance  in  y  ■from  X  a) 

RXSO:  (a  Total  variance  in  X  from  Y  a) 

real; 

OPT:  (a  Menu  option  a) 

CHAR; 

NAME:  (a  Field  or  variable  name  a) 

STRING; 

NAMES:  (a  Sorted  names  by  type  a) 

HEADERi; 

VY,  (a  Individual  variances  in  Y  a) 

VX:  (a  Individual  variances  in  X  a) 

VECTOR; 

RYV,  (a  Criterion  self-correlation  a) 

RXX,  (a  Predictor  self-correlation  a) 

RY,  (a  YCANVARs  a) 

RX:  (a  XCANVARs  a) 

MATRIX; 

(aaaaaaaaaaaaaaaaaaaeaaaaaaaaaaasaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

(a  Internal  Procedures  a) 

iaaaaaaaaaaaeaaaaaaaaaaaaaaaaaaaaaaaeaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

PROCEDURE  SORTNAMES; 


BEGIN 

index: -0; 

FOR  l:“t  TO  WIDTH  DO  (a  Sort  names  by  type  a) 

IF  (GROUPCIlal)  THEN  (a  Criterions  a) 

BEGIN 

index: -INDEX+i; 

NAMES! INDEX 3 : -SPECS 1 1 1  3 ; 

END) 


FOR  l;-l  TO  WIDTH  DO 

IF  (GR0UPCI3-2>  THEN  (a  Predictors  a) 

BEGIN 

INDEX:-INDEXai| 

NAMES t INDEX 3 : -SPECS 1 C 1 3 ; 

END) 
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end;  <«  End  o^f  SORT  NAMES  by  type  •) 


PROCEDURE  GETYCVS; 

BEGIN 

G0TQXY(7,5) ; 

FOR  l:*l  TO  P  DO  (*  Calculate  YCANVAR’s  *> 

BEGIN 

NAME: -NAMES! 1 1;  (•  Field  headers  •) 

IF  (LENGTH (NAME ) >B)  THEN 
NAME: -COPY (NAME, 1,B) ; 

WRITE (NAME:9) ; 

IF  (PRINTER)  THEN 

WRITE (PTR, name: 9) ; 

END; 
row: -7; 

IF  (PRINTER)  THEN 

WRITELN(PTR,CHR (13) ) ; 

FOR  l:-l  TO  P  DO  (a  RY  -  R(YY)  *  Alpha  *) 

FOR  J:-1  to  N  DO 
BEGIN 

RYtl,J3:-o.o; 

FOR  L:-1  to  P  DO 

RYtI,J3:-RYtl,  J3-t-RYYII,L3*ALPHACL,  J3; 

end; 

FOR  l;-l  TO  P  DO  (•  Print  the  RY’e  *> 

BEGIN 

G0T0XY(0,R0W); 

WRITECYCV’ :4, 1, '  »>; 

IF  (PRINTER)  then 

write(ptr,*ycv':4,i,'  ’>; 

FOR  J:-l  TO  N  DO 
BEGIN 

WRITEIRYII, J3:9:4) ; 

IF  (PRINTER)  THEN 

WRITE<PTR,RYtI, J3:9:4) ; 

end; 

ROW:-ROW-»lt 
IF  (PRINTER)  T)«N 
WRITELN(PTR)| 

END;  (•  End  of  Print  the  RY'e  *) 

IF  (PRINTER)  THEN 

WRITELN (PTR.CHR ( 13) ) | 

END!  (•  End  of  GET  Y  Cenonicel  VariateS  •) 

PROCEDURE  6ETXCVG; 

BEGIN 

FOR  l:-l  TO  K  DO 
BEGIN 


(•  Calculate  the  XCANVAR'a  •) 


NAME: -NAMES t (P+I>  3; 

IF  (LENGTH (NAME ) >B>  THEN 
NAME: -COPY (NAME, 1 ,B) ( 
write(name:9) ; 

IF  (PRINTER)  THEN 

WRITE (PTR, NAME; 9) ; 

END; 

row: -Row*2; 

IF  (PRINTER)  THEN 

WR1TELN(PTR,CHR<13) ) ; 

FOR  l:-l  TO  K  DO  (*  RX  -  R(XX)  *  Beta  *) 

FOR  j:=i  to  n  do 
BEGIN 

RXtl, J3:-0.0; 

FOR  l:-i  to  k  do 

RXCl, J3:-RXtI, J3*RXXC1,L3*BETACL, Jl; 

end; 

FOR  l:-l  TO  K  DO  (*  Print  the  RX’«  *) 

BEGIN 

G0T0XY(0,R0W) ; 

WR1TE('XCV' ;4,  I,  ’  m; 

IF  (PRINTER)  THEN 

WR1TE<PTR,'XCV';4,I,’ 

FOR  a;-i  TO  N  DO 
BEGIN 

WRlTE(RXtI, J3;9;4)  ; 

IF  (PRINTER)  THEN 

WR1TE(PTR,RXC1, J3:9;4) ; 

end; 

ROw:-Row•^i; 

IF  (PRINTER)  THEN 
WBITELN(PTR) I 

end;  (*  End  of  Print  the  RX’»  *) 

IF  (PRINTER)  THEN 

WRITELN(PTR,CHR(J3) )| 

END;  (•  End  o-f  BET  X  Canonical  VariateS  «) 


) 


PROCEDURE  CALC INDEXES; 

BEGIN 

RYSa:-0.0( 

FOR  INDEX :-l  TO  N  DO  (•  Calculate  Y  variances  •) 

BEGIN 

VY[IN0EX3:-0.0; 

FOR  l:-l  TO  P  DO 

S^YtlNDEXlt-VYIINDEXI-^BQRIRYCI,  INDEX!)  ; 

VYC INDEX  3: -(VYC INDEX 3/P>»EIGVALC INDEX  3; 

RYBQ :  -RYSO^-VYl  I NDEX  3  ( 

end; 


RX60:-0.OI 

FOR  INDEX: -1  TO  N  DO 


(•  Calculate  X  variances  •) 


BEGIN 

VXCINDEX3:=0.0; 

POR  l:*l  TO  K  DO 

VXt INDEXD:=VXt INDEX3*50R (RXC I, INDEX] )  ; 
VXC INDEX  3: ><VXC INDEX ]/K) •EIGVALC INDEX]; 
RXSQ: >RXSO«VX  C INDEX  3  ; 

END; 

END;  <«  End  O'f  CALCuIatc  INDEXES  O'f  redundancy  *) 


PROCEDURE  PRINTRESULTS; 

BEGIN 

GDTDXV<24,2) ; 

WRITELN<CHR(1S>,'  INDEXES  OF  REDUNDANCY 
CHR(14) ,CHR( 13>  ,CHR( 13) >  ; 

IP  (PRINTER)  THEN 

WRITELN(PTR, ’ INDEXES  OF  REDUNDANCY: •, CHR ( 13) ) ; 


FOR  l:»l  TO  N  DO 
BEGIN 

WRITELNCWY’SIO,!,’  «  '  ,  VYC  I  3  :  6:  4 )  ; 

IF  (PRINTER)  THEN 

WRITELN(PTR,'VY’:IO,I,'  -  ’ , VYC I  3 : 6: 4 ) ; 

END; 


WRITELNC  ':16,' - ' , CHR ( 1 3) , RYSQ: 23: 4, ’  o4 

'total  variance' • CHR ( 13) ) ; 

IF  (PRINTER)  THEN 

WRITELN(PTR, ’  16, ' - ' ,CHR(13> ,RYSQ:23:4, 

'  04  total  variance’ , CHR ( 13) > ; 

FOR  l;-l  TO  N  DO 
BEGIN 

«RITELN(’VX’;10,I,’  -  ’,VXII3:6;4> ; 

IF  (PRINTER)  THEN 

WRITELN(PTR, 'VX' : 10, I, ’  ■  ’ , VX 1 1  3 : 6: 4 ) ; 

end; 

WRITELNC  ’;16,' - * , CHR ( 13) , RXBO: 23: 4, ’  o4 

'total  variance’} I 
IF  (PRINTER)  THEN 

WR1TELN(PTR, ’  ’;16,’ - ’, CHR ( 13) , RXBO: 23: 4, 

'  o4  total  variance'); 

END;  (a  End  o4  PRINT  the  REBULTB  •) 


Hain  body  o4  BTRUCTURECORR 


BEGIN 

P;-BR0UPC-13l 
K:-6R0UP[0]; 
IF  (P>K>  THEN 

n:-k 

ELBE 


<•  Initialise  paraeetera 


n:*=p 


FOR  l:»l  TO  P  DO  (*  Access  sel '^-correl  ati  ons  *> 

FOR  Jr-l  TO  P  DO 
RYYtl, 

FOR  l;»l  TO  K  DO 

FOR  J: =1  TO  K  DO 

RXXCl,J3:«CMt (P+1) , (P+J) 3; 

BORTNAMES;  (•  Sort  names  by  type  •) 

G0T0XY(5,3) 1 

MRITELN(CHR(15) , *  STRUCTURE  CORRELATIONS  ',CHR(14)>; 

IF  (PRINTER)  THEN  <*  Printer  hesejing  •) 

BEGIN 

WRITELN(PTR, 'STRUCTURE  CORRELATIONS: ’ ,CHR(13> ) ; 

WRITE (PTR,’  •:?); 

END; 

QETYCVS;  (•  Calculate  the  YCANVAR's  s) 

R0M:-R0M+2) 

IF  (PRINTER)  THEN 

WRITE (PTR,*  '!7)| 

G0T0XY(7,R0W) J 

6ETXCVS;  (•  Calculate  the  XCANVAR's  •) 

ERASE (22, 1) I 
e0T0XY(16,22) { 

WRlTECPress  any  key  to  get  Indexes  of  Redundancy  ')t 
BETOPTION(OPT) J 
ERASE (3, 20) I 
G0T0XY(0,22) J 

WRITE(’Calculating  Indexes  of  Redundancy.  . 

'Please  stand  by  ')| 

CALCINDEXES;  (•  Indexes  of  Redundancy  •) 

ERASE (22, 1) I 

PRINTRESULTS:  (•  Print  Indexes  of  Redundancy  •) 

e0T0XY(16,22)| 

WRITE ('Done.  Press  any  key  to  exit  CANCOR  ’)| 
BETOPTION(OPT) ! 

ENDI  (e  End  of  STRUCTURE  CORRelations  •) 


(eeeeeeeseeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeesaeeeeeseeeeeeseeeeeesessss) 
<e  Initialiiation  part  of  UNIT  s) 
(••eeeea*eaa***#eeeees*a##aseeaeeaeeeeeeeeaaeeaesa**es«seeaae»eaa»ss) 


END. 


<*«S**) 

UNIT  MU_K;  intrinsic  code  21! 

INTERFACE 

USES  TRANSCEND,  MAIN_UNIT,  HU_E! 

PROCEDURE  GETFACTSCORES(VAR  DATA: RAWDATA; VAR  COEF: MATRIX! 

VAR  BR0UP:HEADER2!NUMREC, width: INTEGER! 
PRINTER: BOOLEAN) | 

PROCEDURE  FACTORMAT (VAR  E I GVAL: VECTOR; VAR  El GVEC, FACTCOEF: MATRI X ; 

VAR  SPECSl: HEADER! ! VAR  GROUP: HEADER2; 

WIDTH: INTEGER; PRINTER: BOOLEAN) ! 

PROCEDURE  SETCANCORST ATS ( VAR  E I GVAL , CANCORS , W I LKGL , CH I SOR : VECTOR ! 

NUMREC,P,K: integer; printer: BOOLEAN) ; 

IMPLEMENTATION 


Main  body  o*  MU_K 


PROCEDURE  GETFACTSCORES; 


This  procsdurs  calculates  the  Factor  Scores  and  then 
prints  and/or  saves  them,  as  desired. 

F(i)  ■  X  a  Alphaii) 


I,J,L, 

<* 

Iteration  counters 

*) 

N, 

<a 

Number  o4  manifestations 

*) 

ns: 

INTEGER! 

<• 

Number  of  Significant  Factors 

a) 

SPCSi: 

HEADER! ; 

<* 

Saved  field  names 

a) 

<• 

Pointers  to  manifestations 

a) 

6PCS2: 

HEADER2! 

<* 

Saved  filed  widths 

a) 

JOB, 

opt: 

CHARI 

<• 

Menu  options 

a) 

FIELD: 

STRING! 

<e 

Field  number  identifier 

a) 

Internal  Proceduri 

PROCEDURE  CALCTHESCORES! 

BEGIN 

FOR  L:-1  to  NUMREC  DO 
FOR  l:-l  TO  NS  DO 


(**< 


BEGIN 

8C0RE6CL,I]:>0.0t 

FOR  j:-i  to  n  do 

8CORE8tL,13:-8COREBCL,I]-i- 

DATACL,ACJ]]*COEFCJ,13| 

END! 

ENDI  <•  End  o*  CALCulat*  THE  SCORES  •> 


PROCEDURE  PRINTTHESCORESI 
BEGIN 

ERASE <19, 4) I 
BOTOXY (30,3)1 

HRITELN(CHR(1S),’  FACTOR  SCORES  >,CHR(14)>| 

B0T0XV<0,8)|  (•  Display  tha  haadars  •) 

MRITEC  *:10,’CASE  *)| 

FOR  l:«l  TO  NS  DO 

WRITE <’  FACT  *,1,*  •)» 

MRITELN<CHR(13))| 

IF  (PRINTER)  THEN  (a  Print  tha  haadara  a) 

BEGIN 

HRITELNCPTR, 'FACTOR  SCORES: ' ,CHR ( 13) ) I 
HR1TE<PTR,'  *:10,’CA6E  ')| 

FOR  1:>1  TO  NS  DO 

NRITEIPTR,'  FACT  ')» 

HRITELN  <PTR,CHR ( 13) ) I 

ENDI 

FOR  L:-1  to  NURREC  do  (a  Print  all  tha  acoraa  a) 

BEGIN 

IF  ((L  >  l>  AND  (L  MOD  14  •  1)>  THEN  (a  Pauaa  a) 
BEGIN 

BOTOXY (22, 22) I 

NRITE(’Praaa  any  kay  to  continua  ')| 
BETaPTiaN(OPT> I 
ERASE (7, 16) I 
BOTOXY (0,7) I 

ENDI  (a  End  o4  Pauaa  at  paga  and  a) 

WRITE (U: 13,'  'll 
FOR  I:>1  TO  N8  DO 

NRITE(8C0RESIL,J3:7;«,'  '>f 
WRITELNI 

IF  (PRINTER)  THEN 
BEBIN 

WRITE (PTR,L: 13,'  ')! 

FOR  1:-1  TO  NB  DO 

WRITE (PTRpBCOREBCL, 13:714,'  ')| 
HRITELN (PTR) I 

ENDI 

ENDI  (a  End  of  Print  all  tha  acoraa  a) 

BOTOXY (22, 22) I 

NRlTE('Dano.  Proaa  any  kay  to  continua  *>| 
BETOPTIONMIPT)  I 
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ERASE (3, 20) I 


END;  (•  End  O';  PRINT  THE  SCORES  •> 


< 


> 


PROCEDURE  BAVETHESCORES: 

BEGIN 

ERASE (19,4) ; 

GOTOXY (0,5) ; 

WRlTE(’N«t<»  «ur«  a  pralormattad  Data  diak  la  *, 

'on-lina.  Praaa  any  kay  to  continua  ’); 
SETOPTION(OPT) 1 

POR  1:^1  TO  NS  DO  (a  Sat  ^iald  namae  a) 

BEGIN 

FIELD:«COPY(' J234567B9’ ,1,1)1 
BPCSltlll-CONCAT ('  FACT  ', FIELD,’  ’); 

END; 

6PCG2C-13:-NUMREC; 

6PCS2C03:«NS; 

FOR  I:>1  TO  NS  DO 
BPCS2I13:-8; 

6AVEF I LE ( SCORES , 8PCS 1 , 6PCS2 ) ; 
end;  (a  End  SAVE  THE  SCORES  a) 


(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 
(•  Hain  body  o4  6ETFACTBC0RES  a) 
<aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 


BEGIN 

NS:aGR0UPC-13|  <a  Initiallta  paraaatara  a> 

N:-GR0UP[03; 

J:>oi 

FOR  I:*!  TO  WIDTH  DO  (a  Sat  aaqiiantlal  pointara  a> 

IF  <6R0UPC1}>0>  THEN 
BEGIN 

JlaJai; 

ACJ}:-I( 

END! 

CALCTHE8C0RES;  (a  Calculata  Factor  Gcoraa  a) 

ERA6E(22,1)| 

e0T0)(V  <0,16)1 

HRITELNl 'Salact  daairad  option:' >; 

WRITELNC  1  -  Print  ’.NUriREC,’  Factor  Scoraa’)! 

HRITELNC  2  >  Sava  tha  acoraa  to  diak')| 

WRITELNC  3  -  Do  both  Print  and  Sava’ >  I 

WRITELNC  4  -  Do  nothing.  Eait  FACTOR  routina’)! 

BET0PT10N(J0B>I 

WHILE  (J0B<’1’)  OR  <J0B>’4*)  DO 
BETOPTIONIJOBX 
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ERASE (18, 5); 

IF  (JOB=’l’)  DR  (J0B=’3')  THEN 
PRINTTHESCORES; 

IF  <JDB=’2*)  OR  <J0B=’3’)  THEN 
SAVETHESCORES; 

GDT0XY(16,22)  1 

WRITE<’Pr»*s  any  key  to  eKit  FACTOR  routine  ’); 
BETORTION(OPT) ; 

END;  <*  End  o^f  GET  FACT  or  SCORES  *) 

PROCEDURE  FACTORMAT; 


*  *) 


This  procedure  calculates  and  prints  the  Factor  a> 

Loadings,  Communal i ties  and  Factor  Score  •) 

Coc'f'f icients  'for  each  cf  the  designated  •) 

variables  under  FACTOR  analysis.  •) 

•  ) 

aaaeaaaaaaaaaaaaaaaaaaaaeaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

VAR 

I,il,  (a  Iteration  counters  •> 

INDEX,  (e  IndeM  o4  designated  field  •) 

N,  (a  Number  o4  total  factors  a) 


NS:  (a  Number  of  selected  factors  a) 

INTEGER; 

gum:  (a  Gum  of  squares  (normalize)  a> 


real; 

communal:  (a  Total  communal ities  a) 

vector; 

FACTLOAD:  (a  Principal  Factor  Loadings  a) 

matrix; 

OPT:  (a  Menu  option  a) 

CHAR; 

NAME,  (a  Name  displayed  on  screen  a) 

NAMEP:  (a  Name  printed  on  printer  a) 

STRING; 

(aeeeeaeeeceeeeeeeeeeeeeeesseeeseeeeeeeaaeeeeeeeeeeeeeeeeeeeaaaeeess) 
(a  Internal  Procedures  a) 

(aaaaaaeaaaaeaeeeeeeeeeeeeeaaaaaeaeeaeeeaasaeeeeeeeeeaaaeeeeeeeeeees) 


PROCEDURE  NORMALIZE;  (a  Required  eigenvectors  a) 


BEGIN 

FOR  J:-!  to  N6  do 
BEGIN 

8UM:>0.0( 

FOR  l:-l  TO  N  DO 

bum: -BUMaGQR (ElBVECI I , J 3 > ; 

FOR  l:-t  TO  N  DO 

EieVECC 1 , J 3 : -EIBVECC 1 , J 3 /SORT (SUM) I 

end; 

END;  (a  End  of  NORMALIZE  eigenvectors  a) 


< 


) 


PROCEDURE  GETSTATS; 

BEGIN 

POR  ::*1  TO  N  DO 

FOR  J:*'!  to  ns  DO 

factload C I , J  3 : eSORT  < E I GUAL  C  J  3 ) *E I GVEC C I , J  3 ; 

FOR  l:*l  TO  N  DO 

FOR  J:=l  TO  NS  DO 
BEGIN 

COMMUNALtl3:«COMHUNALC 13+SQR ( FACTLOAD C I , J 3 ) ; 
FACTCOEF  C I , J  3 : -FACTLOAD C I , J  3 /E I GVAL  C  J  3  ; 

IF  <COHMUNALCI3  >  1.0)  THEN 
C0HnUNALCI3:-  1.0; 


END;  (•  End  o4  GET  STATisticS  •) 


<*  Print  h»«d»rs 


PROCEDURE  PRINTLOADINGS; 

BEGIN 

60T0XY(9,7) ; 

FOR  l:-l  TO  NS  DO 

WRITE <•  FACT  ’>5 

WRITELN(CHR<13)); 


IF  (PRINTER)  THEN 
BEGIN 

WRITE (PTR,*  ':17)1 
FOR  l:-l  TO  NS  DO 

WRITE (PTR, ’  FACTOR  ',!); 

WR I  TEL  N  ( PTR  ,  CHR  ( 1 3 )  )  ; 

END; 


index: -o; 

FOR  l:-l  TO  WIDTH  DO 

IF  (GROUP! 1 3 >0)  THEN 
BEGIN 

IN0EX:-IN0EX'«-1| 

NAnEP:-SPECSlC13( 


(*  Print  th»  values 


(•  Designated  variable  •> 


IF  (LENGTH(NAnEP) >15)  THEN 
NAnEP:-C0PY(NAI1EP,  1, 15) ; 

IF  (LENGTH (NAHEP) >8)  THEN 
NAnE:-COPY(NAHEP, 1 ,B) 

ELSE 

nahe: -NAHEP; 

HRlTE(NAr£:8,’  ’)| 

IF  (PRINTER)  THEN 

WRITE(PTR,NAHEP: 15,  •  '); 

FOR  J:-1  to  N8  do 


BEGIN 

WR1TE<’  ’.FACTLOADCINDEX, J3;&:4, ’  '); 
IF  (PRINTER)  THEN 
WRITE (PTR,’ 

FACTLDAD[INDEX,J3:B:4, ’  ’> 


end: 


WRITELN; 

IF  (PRINTER)  THEN 
WRITELN(PTR) : 

END; 

end;  (•  End  o-f  PRINT  Factor  LOADINGS  •) 


) 


PROCEDURE  PRINTCOMMUNALITIES; 

BEGIN 

G0T0XY(0,5) ; 

WRITELN ('VARIABLE' : 17, 'COMMUNAL! TV' : 16) ; 

IF  (PRINTER)  THEN 

WRITELN(PTR,CHR(13> , 'VARIABLE' : 17, 

'COMMUNAL ITY' ; 16,CHR(13) ) ! 

G0T0XY(0,7) ; 

INDEX:>0!  (•  Print  th»  valuas  •> 

FOR  l;»l  TO  WIDTH  DO 

IF  (GROUP!  n>0)  THEN 
BEGIN 

index;  =  1NDEX-H; 

NAME:-SPECSUI3; 


IF  (LENGTH (NAME) >15)  THEN 
NAME: -COPY (NAME, 1, 15) ; 


WRITELN (NAME; 15,'  '15,'  ', 

COMMUNAL! INDEX 3: 5: 4,  ' 

IF  (PRINTER)  THEN 

WRITELN(PTR,NAME: 15, '  ';5,’ 
COMMUNAL 1 1 NDE  X  3 : 5 : 4 , 


end; 


) ; 


IF  (PRINTER)  THEN 

WRITELN (PTR, CHR( 13) ) ; 

END;  (•  End  oF  PRINT  COMMONALITIES  •) 


) 


PROCEDURE  PRINTCOEFFICIENTG; 

BEGIN 

e0T0XY(0,5) ; 

WRITELN (’FACTOR  SCORE  COEFFICIENTS: ’> I 
IF  (PRINTER)  THEN 

WRITELN (PTR, 'FACTOR  SCORE  COEFFICIENTS; ’ ,CHR ( 13) ) I 

e0T0XY(9,7)|  <•  Print  h*ad*r*  *) 

FOR  l:-l  TO  NS  DO 

WRITE (’  FACT  ’>1 

WRlTELN(CHR(15>)t 


IF  (PRINTER)  THEN 
BEGIN 

WRITE (PTR,'  ’:19); 

FOR  l:*l  TO  NS  DO 

WRITEIPTR,’  FACTOR  ’)! 

WRITELN<PTR,CHR(13) ) ; 

END; 


indexing; 

FOR  l:«l  TO  WIDTH  DO 

IF  (Group:  n>0)  then 
BEGIN 

INDEX:>INDEX-^l; 

NA«EP:-SPECE1C13; 


(*  Print  the  valuf 


(•  Designated  variable 


IF  (LENGTH (NAMEP) >15)  THEN 

namep: -copy (namep,  i ,  i5)  ; 

IF  (LENGTH (NAMEP) >B)  THEN 
NAME : •COPY ( NAME  P , 1 , B ) 

ELSE 

NAME; •NAMEP; 

WRITE (NAME: B, ’  ’>; 

IF  (PRINTER)  THEN 

WRITE (PTR, NAMEP: 15, ’  ’>; 

FOR  J;»l  TO  NS  DO 
BEGIN 

W?ITE(’  ',FACTCOEFr INDEX, J3;fc:4, ' 

IP  (PRINTER)  THEN 

WRITE (PTR,*  *, 

FACTCOEFCINDEX,J3:fe:4,*  *); 

end; 

WRITELN; 

IF  (PRINTER)  THEN 
WRITELN (PTR) f 


IF  (PRINTER)  THEN 

WRITELN (PTR, CHR ( 13) ) I 

END;  (•  End  o*  PRINT  factor  acore  COEFFICIENTS  ♦) 


Main  body  of  FACTOR  MATrln 


BEGIN 

(a«R  TRANSCEND  •) 

»I8:-6R0UPC-13| 

N: •GROUP! 03; 

FOR  l:-l  TO  N  DO 

COMMUNAL! 1 3: -O.Ol 


(•  Retain  UNIT  in  Memory 
<•  Initialize  parameters 


NORMALIZE; 


SETSTATS; 
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EPASE(22,1); 


BOTOXY (0,5) ; 

WRITELN(’ FACTOR  MATRIX  USING  PRINCI'  FACTOR  (S)  ; 

IF  (PRINTER)  THEN 

WRITELN(PTR, ’FACTOR  MATRIX  USING  PRINCIPAL  FACTOR (S):’, 
CHR (13) ) ; 

PRINTLOADINGS;  (*  Factor  loadings  ♦) 

GOTOXY (0,22) 5 

WRITE (CHR (29) Press  any  key  to  print  Communal i t i es  ’); 
BETOPTION(OPT) 1 
ERASE (S. 18) i 

PRINTCOMMUNALITIES;  (a  Total  explained  *) 

BOTOXY (0,22) ; 

WRITE(’Press  any  key  to  print  Factor  Score  Coe-f -f i ci ents  ’); 

BETOPTION(OPT) ; 

ERASE (S, 18): 

PRINTCOEFFICIENTS;  (*  Factor  coe'f  ■(  i  ci ents  •) 

BOTOXY (22,22) ( 

WRlTECPress  any  key  to  continue  ’>J 
BETOPTION(OPT) J 
ERASE (5, 18) i 

IF  (PRINTER)  THEN 

FOR  l;-l  TO  3  DO 
WRITELN(PTR) ; 

ENDl  (*  End  o4  FACTOR  MATrix  *) 

(aaeaaaeaeaaaeaaaaaaaeaaaaaaaaaaeaaaaaaaaaaaaeaaaaaaaaaaaaaaaaaaaaaa) 

PROCEDURE  GETCANCORSTATS; 


Thi*  procedure  calculates  the  Canonical  Correlation, 
Milk’s  Lambda,  and  Chi  Square  statistics  from 
the  Eigenvalues  and  then  prints  them  all. 


VAR 


I, 

(a 

Iteration  counter 

a) 

INDEX, 

(a 

One  of  *N’  values 

a) 

n: 

INTEGER; 

<a 

Lessor  of  P  and  K 

a) 

HULT, 

(a 

Multiplication  constant 

a) 

VALUE: 

real; 

(a 

Calculated  Wilk’s  Lambda 

a) 

opt: 

(a 

Menu  option 

a) 

CHARI 


■*> 

a) 

a) 

a) 

a) 

a) 

'a) 


(aaaaaaaaaasaaaaaeaaaaaaaaaaeaaaaaaeaaaaaaaaaaasaaaaaaaaaaaaaeaaaaaa) 
(a  Internal  Procedures  •) 
(•aaaaseaeaseaaaaeaaaaaaaaaaaaaaeaaaeaaaaaaaasasaaaaaaaaaaaaaaaaaaaa) 
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PROCEDURE  CALCSTATS 


BEGIN 

MULT:»-<NUMREC-l-<P+K+l)/2.0) ; 

FOR  INDEX :=1  TO  N  DO 
BEGIN 

IF  <EIGVALCINDEXI>0.0)  THEN 

CANCORSt INDEX3:=BQRT  vE I GVAL C INDEX  I ) 

ELSE 

CANCORSC INDEX3:=99.9999; 

VALUE: =1 .0; 

FOR  1:*1NDEX  TO  N  DO 

VALUE : -VALUE* <1.0-EIGVAL[ 13) ; 

milkslcindex3:>value; 

IF  <VALUE<=0.0)  THEN 

CHI SQRC INDEX  3: =99. 9999 

ELSE 

CHISQRCINDEX3:=MULT*LN( VALUE) ; 

END; 

END;  <•  End  o-f  CALCulate  the  STATieticS  *> 

r****************************************************************) 

PROCEDURE  PRINTHEADINGS; 

BEGIN 

B0T0XY<13,5) ; 

WRITELN(CHR(15>,'  CANONICAL  CORRELATION  ',CHR(14)); 
B0T0XY(0,8) ; 

MRITELNCCANONICAL’  :30,  ’WIlK’  'B’  .‘9,  ’CHI-’  :B)  ,* 

HR 1TELN(’ NUMBER’ , ’EIBENVALUE’ : 12, ’ CORRELATION’ : 13, 

•  LAMBDA ’ ; B , ’ SQUARE ’:9,CHR(13))J 

IF  (PRINTER)  THEN  (*  Printer  Heedinge  *) 

BEGIN 

HR I TELN<PTR, ’CANONICAL’ :30, ’WILK’ ’B’ :9, ’CHI-’ :B) ; 
HR I TELN  <  PTR , ’ NUMBER ’ , ’ E I BENVALUE ’ : 1 2 , 

’CORRELATION’ : 13, ’LAMBDA’ :B, ’SQUARE’ ; 9) ; 
HRITELN(PTR) ; 

end; 

END;  <•  End  04  PRINT  the  HEADINGS  •) 

PROCEDURE  PRINTSTATS; 

BEGIN 

FOR  INDEX:-1  TO  N  DO  (•  Output  etetietice  •) 

BEGIN 

HRITELN ( INDEX: 3,EI6VAL[ INDEX  3: 13:4, 

CANCORSt INDEX  3: 12:4, HILKSLC INDEX  3: 11:4, 
CH1S0RC1NDEX3:9:4> I 

IF  (PRINTER)  THEN 

HRITELN(PTR, index: 3, EIGVALt INDEX  3: 13:4, 
CANCORSt INDEX  3: 12:4, 


WILKSLt INDEX3: 11:4, 
CH1SQRCINDEX]:9:4) ; 

END; 

IF  (PRINTER)  THEN 

WRITELN(PTP,CHR(13) ) 1 
END;  <*  End  of  PRINT  the  BTATisticS  •) 


<*  Main  body  of  GETSTATS  *> 

BEGIN 

(•♦R  TRANSCEND  •)  <•  Retain  UNIT  in  mentory  *; 

IF  <P>K)  THEN  (a  Initialize  parametere  *> 

N:=K 

ELSE 

N;=Pi 


CAUCSTATS;  <♦  Calculate  the  etatistics  a) 

60T0XY<16,22) ; 

WRlTE(’Done.  Press  any  key  to  print  results.  ’>; 
GETOPTION(OPT) ; 

ERASE (20, 3) ; 

PRINTHEADINGS; 


PRINTSTATS;  <a  Print  the  statistics  a) 

END;  <a  End  of  BET  CANCOR  STATisticS  a) 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 

(a  Initialization  part  of  UNIT  a) 

(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) 
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